// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.

namespace Microsoft.FSharp.Quotations

open System
open System.IO
open System.Reflection
open System.Collections.Generic
open Microsoft.FSharp
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Primitives.Basics
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Reflection
open Microsoft.FSharp.Core.Printf
open Microsoft.FSharp.Text.StructuredPrintfImpl
open Microsoft.FSharp.Text.StructuredPrintfImpl.LayoutOps
open Microsoft.FSharp.Text.StructuredPrintfImpl.TaggedTextOps

#nowarn "52" //  The value has been copied to ensure the original is not mutated by this operation

#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
#endif

//--------------------------------------------------------------------------
// RAW quotations - basic data types
//--------------------------------------------------------------------------

module Helpers = 
    let qOneOrMoreRLinear q inp =
        let rec queryAcc rvs e = 
            match q e with 
            | Some(v,body) -> queryAcc (v::rvs) body 
            | None -> 
                match rvs with 
                | [] -> None
                | _ -> Some(List.rev rvs,e) 
        queryAcc [] inp 

    let qOneOrMoreLLinear q inp =
        let rec queryAcc e rvs = 
            match q e with 
            | Some(body,v) -> queryAcc body (v::rvs) 
            | None -> 
                match rvs with 
                | [] -> None
                | _ -> Some(e,rvs) 
        queryAcc inp []

    let mkRLinear mk (vs,body) = List.foldBack (fun v acc -> mk(v,acc)) vs body 
    let mkLLinear mk (body,vs) = List.fold (fun acc v -> mk(acc,v)) body vs 

    let staticBindingFlags = BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
    let staticOrInstanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
    let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
#if FX_RESHAPED_REFLECTION
    let publicOrPrivateBindingFlags = true
#else
    let publicOrPrivateBindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic
#endif

    let isDelegateType (typ:Type) = 
        if typ.IsSubclassOf(typeof<Delegate>) then
            match typ.GetMethod("Invoke", instanceBindingFlags) with
            | null -> false
            | _ -> true
        else
            false

    let getDelegateInvoke ty = 
        if not (isDelegateType(ty)) then invalidArg  "ty" (SR.GetString(SR.delegateExpected))
        ty.GetMethod("Invoke", instanceBindingFlags)


    let inline checkNonNull argName (v: 'T) = 
        match box v with 
        | null -> nullArg argName 
        | _ -> ()
        
    let getTypesFromParamInfos (infos : ParameterInfo[]) = infos |> Array.map (fun pi -> pi.ParameterType)

open Helpers


[<Sealed>]
[<CompiledName("FSharpVar")>]
[<System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Usage","CA2218:OverrideGetHashCodeOnOverridingEquals",Justification="Equals override does not equate further objects, so default GetHashCode is still valid")>]
type Var(name: string, typ:Type, ?isMutable: bool) =
    inherit obj()

    static let getStamp =
        let mutable lastStamp = -1L // first value retrieved will be 0
        fun () -> System.Threading.Interlocked.Increment &lastStamp

    static let globals = new Dictionary<(string*Type),Var>(11)

    let stamp = getStamp ()
    let isMutable = defaultArg isMutable false
    
    member v.Name = name
    member v.IsMutable = isMutable
    member v.Type = typ
    member v.Stamp = stamp
    
    static member Global(name,typ: Type) = 
        checkNonNull "name" name
        checkNonNull "typ" typ
        lock globals (fun () -> 
            let mutable res = Unchecked.defaultof<Var>
            let ok = globals.TryGetValue((name,typ),&res)
            if ok then res else
            let res = new Var(name,typ)
            globals.[(name,typ)] <- res
            res)

    override v.ToString() = name

    override v.GetHashCode() = base.GetHashCode()

    override v.Equals(obj:obj) = 
        match obj with 
        | :? Var as v2 -> System.Object.ReferenceEquals(v,v2)
        | _ -> false

    interface System.IComparable with 
        member v.CompareTo(obj:obj) = 
            match obj with 
            | :? Var as v2 -> 
                if System.Object.ReferenceEquals(v,v2) then 0 else
                let c = compare v.Name v2.Name 
                if c <> 0 then c else 
#if !FX_NO_REFLECTION_METADATA_TOKENS // not available on Compact Framework
                let c = compare v.Type.MetadataToken v2.Type.MetadataToken 
                if c <> 0 then c else 
                let c = compare v.Type.Module.MetadataToken v2.Type.Module.MetadataToken 
                if c <> 0 then c else 
#endif
                let c = compare v.Type.Assembly.FullName v2.Type.Assembly.FullName 
                if c <> 0 then c else 
                compare v.Stamp v2.Stamp
            | _ -> 0

/// Represents specifications of a subset of F# expressions 
[<StructuralEquality; NoComparison>]
type Tree =
    | CombTerm   of ExprConstInfo * Expr list
    | VarTerm    of Var
    | LambdaTerm of Var * Expr 
    | HoleTerm   of Type * int

and 
  [<StructuralEquality; NoComparison>]
  ExprConstInfo = 
    | AppOp
    | IfThenElseOp  
    | LetRecOp  
    | LetRecCombOp  
    | LetOp  
    | NewRecordOp      of Type
    | NewUnionCaseOp       of UnionCaseInfo
    | UnionCaseTestOp  of UnionCaseInfo
    | NewTupleOp     of Type
    | TupleGetOp    of Type * int
    | InstancePropGetOp    of PropertyInfo
    | StaticPropGetOp    of PropertyInfo
    | InstancePropSetOp    of PropertyInfo
    | StaticPropSetOp    of PropertyInfo
    | InstanceFieldGetOp   of FieldInfo
    | StaticFieldGetOp   of FieldInfo
    | InstanceFieldSetOp   of FieldInfo
    | StaticFieldSetOp   of FieldInfo
    | NewObjectOp   of ConstructorInfo 
    | InstanceMethodCallOp of MethodInfo 
    | StaticMethodCallOp of MethodInfo 
    | CoerceOp     of Type
    | NewArrayOp    of Type
    | NewDelegateOp   of Type
    | QuoteOp of bool
    | SequentialOp 
    | AddressOfOp 
    | VarSetOp
    | AddressSetOp 
    | TypeTestOp  of Type
    | TryWithOp 
    | TryFinallyOp 
    | ForIntegerRangeLoopOp 
    | WhileLoopOp 
    // Arbitrary spliced values - not serialized
    | ValueOp of obj * Type * string option
    | WithValueOp of obj * Type 
    | DefaultValueOp of Type
    
and [<CompiledName("FSharpExpr")>]
    Expr(term:Tree,attribs:Expr list) =
    member x.Tree = term
    member x.CustomAttributes = attribs 

    override x.Equals(obj) = 
        match obj with 
        | :? Expr as y -> 
            let rec eq t1 t2 = 
                match t1, t2 with 
                // We special-case ValueOp to ensure that ValueWithName = Value
                | CombTerm(ValueOp(v1,ty1,_),[]),CombTerm(ValueOp(v2,ty2,_),[]) -> (v1 = v2) && (ty1 = ty2)
                | CombTerm(c1, es1), CombTerm(c2,es2) -> c1 = c2 && es1.Length = es2.Length && (es1 = es2)
                | VarTerm v1, VarTerm v2 -> (v1 = v2)
                | LambdaTerm (v1,e1), LambdaTerm(v2,e2) -> (v1 = v2) && (e1 = e2)
                | HoleTerm (ty1,n1), HoleTerm(ty2,n2) -> (ty1 = ty2) && (n1 = n2)
                | _ -> false
            eq x.Tree y.Tree
        | _ -> false

    override x.GetHashCode() = 
        x.Tree.GetHashCode() 

    override x.ToString() = x.ToString(false)

    member x.ToString(full) = 
        Microsoft.FSharp.Text.StructuredPrintfImpl.Display.layout_to_string Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default (x.GetLayout(full))
        
    member x.GetLayout(long) = 
        let expr (e:Expr ) = e.GetLayout(long)
        let exprs (es:Expr list) = es |> List.map expr
        let parens ls = bracketL (commaListL ls)
        let pairL l1 l2 = bracketL (l1 ^^ sepL Literals.comma ^^ l2)
        let listL ls = squareBracketL (commaListL ls)
        let combTaggedL nm ls = wordL nm ^^ parens ls
        let combL nm ls = combTaggedL (tagKeyword nm) ls
        let noneL = wordL (tagProperty "None")
        let someL e = combTaggedL (tagMethod "Some") [expr e]
        let typeL (o: Type)  = wordL (tagClass (if long then o.FullName else o.Name))
        let objL (o: 'T)  = wordL (tagText (sprintf "%A" o))
        let varL (v:Var) = wordL (tagLocal v.Name)
        let (|E|) (e: Expr) = e.Tree
        let (|Lambda|_|)        (E x) = match x with LambdaTerm(a,b)  -> Some (a,b) | _ -> None 
        let (|IteratedLambda|_|) (e: Expr) = qOneOrMoreRLinear (|Lambda|_|) e
        let ucaseL (unionCase:UnionCaseInfo) = (if long then objL unionCase else wordL (tagUnionCase unionCase.Name)) 
        let minfoL (minfo: MethodInfo) = if long then objL minfo else wordL (tagMethod minfo.Name) 
        let cinfoL (cinfo: ConstructorInfo) = if long then objL cinfo else wordL (tagMethod cinfo.DeclaringType.Name)
        let pinfoL (pinfo: PropertyInfo) = if long then objL pinfo else wordL (tagProperty pinfo.Name)
        let finfoL (finfo: FieldInfo) = if long then objL finfo else wordL (tagField finfo.Name)
        let rec (|NLambdas|_|) n (e:Expr) = 
            match e with 
            | _ when n <= 0 -> Some([],e) 
            | Lambda(v,NLambdas ((-) n 1) (vs,b)) -> Some(v::vs,b)
            | _ -> None

        match x.Tree with 
        | CombTerm(AppOp,args)                     -> combL "Application" (exprs args)
        | CombTerm(IfThenElseOp,args)              -> combL "IfThenElse" (exprs args)
        | CombTerm(LetRecOp,[IteratedLambda(vs,E(CombTerm(LetRecCombOp,b2::bs)))]) -> combL "LetRecursive" [listL (List.map2 pairL (List.map varL vs) (exprs bs) ); b2.GetLayout(long)]
        | CombTerm(LetOp,[e;E(LambdaTerm(v,b))]) -> combL "Let" [varL v; e.GetLayout(long); b.GetLayout(long)]
        | CombTerm(NewRecordOp(ty),args)           -> combL "NewRecord" (typeL ty :: exprs args)
        | CombTerm(NewUnionCaseOp(unionCase),args)    -> combL "NewUnionCase" (ucaseL unionCase :: exprs args)
        | CombTerm(UnionCaseTestOp(unionCase),args)   -> combL "UnionCaseTest" (exprs args@ [ucaseL unionCase])
        | CombTerm(NewTupleOp _,args)            -> combL "NewTuple" (exprs args)
        | CombTerm(TupleGetOp (_,i),[arg])         -> combL "TupleGet" ([expr arg] @ [objL i])
        | CombTerm(ValueOp(v,_,Some nm),[])               -> combL "ValueWithName" [objL v; wordL (tagLocal nm)]
        | CombTerm(ValueOp(v,_,None),[])               -> combL "Value" [objL v]
        | CombTerm(WithValueOp(v,_),[defn])               -> combL "WithValue" [objL v; expr defn]
        | CombTerm(InstanceMethodCallOp(minfo),obj::args) -> combL "Call"     [someL obj; minfoL minfo; listL (exprs args)]
        | CombTerm(StaticMethodCallOp(minfo),args)        -> combL "Call"     [noneL;     minfoL minfo; listL (exprs args)]
        | CombTerm(InstancePropGetOp(pinfo),(obj::args))  -> combL "PropertyGet"  [someL obj; pinfoL pinfo; listL (exprs args)]
        | CombTerm(StaticPropGetOp(pinfo),args)           -> combL "PropertyGet"  [noneL;     pinfoL pinfo; listL (exprs args)]
        | CombTerm(InstancePropSetOp(pinfo),(obj::args))  -> combL "PropertySet"  [someL obj; pinfoL pinfo; listL (exprs args)]
        | CombTerm(StaticPropSetOp(pinfo),args)           -> combL "PropertySet"  [noneL;     pinfoL pinfo; listL (exprs args)]
        | CombTerm(InstanceFieldGetOp(finfo),[obj])       -> combL "FieldGet" [someL obj; finfoL finfo]
        | CombTerm(StaticFieldGetOp(finfo),[])            -> combL "FieldGet" [noneL;     finfoL finfo]
        | CombTerm(InstanceFieldSetOp(finfo),[obj;v])       -> combL "FieldSet" [someL obj; finfoL finfo; expr v;]
        | CombTerm(StaticFieldSetOp(finfo),[v])            -> combL "FieldSet" [noneL;     finfoL finfo; expr v;]
        | CombTerm(CoerceOp(ty),[arg])                    -> combL "Coerce"  [ expr arg; typeL ty]
        | CombTerm(NewObjectOp cinfo,args)   -> combL "NewObject" ([ cinfoL cinfo ] @ exprs args)
        | CombTerm(DefaultValueOp(ty),args)  -> combL "DefaultValue" ([ typeL ty ] @ exprs args)
        | CombTerm(NewArrayOp(ty),args)      -> combL "NewArray" ([ typeL ty ] @ exprs args)
        | CombTerm(TypeTestOp(ty),args)      -> combL "TypeTest" ([ typeL ty] @ exprs args)
        | CombTerm(AddressOfOp,args)         -> combL "AddressOf" (exprs args)
        | CombTerm(VarSetOp,[E(VarTerm(v)); e])  -> combL "VarSet" [varL v; expr e]
        | CombTerm(AddressSetOp,args)        -> combL "AddressSet" (exprs args)
        | CombTerm(ForIntegerRangeLoopOp,[e1;e2;E(LambdaTerm(v,e3))])     -> combL "ForIntegerRangeLoop" [varL v; expr e1; expr e2; expr e3]
        | CombTerm(WhileLoopOp,args)         -> combL "WhileLoop" (exprs args)
        | CombTerm(TryFinallyOp,args)         -> combL "TryFinally" (exprs args)
        | CombTerm(TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)])         -> combL "TryWith" [expr e1; varL v1; expr e2; varL v2; expr e3]
        | CombTerm(SequentialOp,args)        -> combL "Sequential" (exprs args)
        | CombTerm(NewDelegateOp(ty),[e])   -> 
            let nargs = (getDelegateInvoke ty).GetParameters().Length
            if nargs = 0 then 
                match e with 
                | NLambdas 1 ([_],e) -> combL "NewDelegate" ([typeL ty] @ [expr e])
                | NLambdas 0 ([],e) -> combL "NewDelegate" ([typeL ty] @ [expr e])
                | _ -> combL "NewDelegate" [typeL ty; expr e]
            else
                match e with 
                | NLambdas nargs (vs,e) -> combL "NewDelegate" ([typeL ty] @ (vs |> List.map varL) @ [expr e])
                | _ -> combL "NewDelegate" [typeL ty; expr e]
        //| CombTerm(_,args)   -> combL "??" (exprs args)
        | VarTerm(v)   -> wordL (tagLocal v.Name)
        | LambdaTerm(v,b)   -> combL "Lambda" [varL v; expr b]
        | HoleTerm _  -> wordL (tagLocal "_")
        | CombTerm(QuoteOp _,args) -> combL "Quote" (exprs args)
        | _ -> failwithf "Unexpected term in layout %A" x.Tree

     

and [<CompiledName("FSharpExpr`1")>]
    Expr<'T>(term:Tree,attribs) = 
    inherit Expr(term,attribs)
    member x.Raw = (x :> Expr)

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Patterns = 

    /// Internal type representing a deserialized object that is yet to be instantiated. Representation is
    /// as a computation.
    type Instantiable<'T> = (int -> Type) -> 'T

    type ByteStream(bytes:byte[], initial:int, len:int) = 
    
        let mutable pos = initial
        let lim = initial + len
        
        member b.ReadByte() = 
            if pos >= lim then failwith "end of stream";
            let res = int32 bytes.[pos]
            pos <- pos + 1;
            res 
        
        member b.ReadBytes n  = 
            if pos + n > lim then failwith "ByteStream.ReadBytes: end of stream";
            let res = bytes.[pos..pos+n-1]
            pos <- pos + n;
            res 

        member b.ReadUtf8BytesAsString n = 
            let res = System.Text.Encoding.UTF8.GetString(bytes,pos,n)
            pos <- pos + n;
            res


    let E t = new Expr< >(t,[])
    let EA (t,attribs) = new Expr< >(t,attribs)
    let ES ts = List.map E ts

    let (|E|) (e: Expr) = e.Tree
    let (|ES|) (es: list<Expr>) = es |> List.map (fun e -> e.Tree)
    let (|FrontAndBack|_|) es = 
        let rec loop acc xs = match xs with [] -> None | [h] -> Some (List.rev acc, h) | h::t -> loop (h::acc) t
        loop [] es



    let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition()  
    let exprTyC = typedefof<Expr<int>>
    let voidTy = typeof<System.Void>
    let unitTy = typeof<unit>
    let removeVoid a = if a = voidTy then unitTy else a
    let addVoid a = if a = unitTy then voidTy else a
    let mkFunTy a b = 
        let (a, b) = removeVoid a, removeVoid b
        funTyC.MakeGenericType([| a;b |])

    let mkArrayTy (t:Type) = t.MakeArrayType();
    let mkExprTy (t:Type) = exprTyC.MakeGenericType([| t |])
    let rawExprTy = typeof<Expr>


    //--------------------------------------------------------------------------
    // Active patterns for decomposing quotations
    //--------------------------------------------------------------------------

    let (|Comb0|_|) (E x) = match x with CombTerm(k,[])  -> Some(k) | _ -> None

    let (|Comb1|_|) (E x) = match x with CombTerm(k,[x]) -> Some(k,x) | _ -> None

    let (|Comb2|_|) (E x) = match x with CombTerm(k,[x1;x2]) -> Some(k,x1,x2) | _ -> None

    let (|Comb3|_|) (E x) = match x with CombTerm(k,[x1;x2;x3]) -> Some(k,x1,x2,x3) | _ -> None
    
    [<CompiledName("VarPattern")>]
    let (|Var|_|)           (E x) = match x with VarTerm v        -> Some v     | _ -> None 

    [<CompiledName("ApplicationPattern")>]
    let (|Application|_|)      input = match input with Comb2(AppOp,a,b) -> Some (a,b) | _ -> None 

    [<CompiledName("LambdaPattern")>]
    let (|Lambda|_|)        (E x) = match x with LambdaTerm(a,b)  -> Some (a,b) | _ -> None 

    [<CompiledName("QuotePattern")>]
    let (|Quote|_|)         (E x) = match x with CombTerm(QuoteOp _,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("QuoteRawPattern")>]
    let (|QuoteRaw|_|)         (E x) = match x with CombTerm(QuoteOp false,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("QuoteTypedPattern")>]
    let (|QuoteTyped|_|)         (E x) = match x with CombTerm(QuoteOp true,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("IfThenElsePattern")>]
    let (|IfThenElse|_|)         input = match input with Comb3(IfThenElseOp,e1,e2,e3) -> Some(e1,e2,e3) | _ -> None

    [<CompiledName("NewTuplePattern")>]
    let (|NewTuple|_|)        input = match input with E(CombTerm(NewTupleOp(_),es)) -> Some(es) | _ -> None

    [<CompiledName("DefaultValuePattern")>]
    let (|DefaultValue|_|)        input = match input with E(CombTerm(DefaultValueOp(ty),[])) -> Some(ty) | _ -> None

    [<CompiledName("NewRecordPattern")>]
    let (|NewRecord|_|)         input = match input with E(CombTerm(NewRecordOp(x),es)) -> Some(x,es) | _ -> None

    [<CompiledName("NewUnionCasePattern")>]
    let (|NewUnionCase|_|)          input = match input with E(CombTerm(NewUnionCaseOp(unionCase),es)) -> Some(unionCase,es) | _ -> None

    [<CompiledName("UnionCaseTestPattern")>]
    let (|UnionCaseTest|_|)   input = match input with Comb1(UnionCaseTestOp(unionCase),e) -> Some(e,unionCase) | _ -> None

    [<CompiledName("TupleGetPattern")>]
    let (|TupleGet|_|)     input = match input with Comb1(TupleGetOp(_,n),e) -> Some(e,n) | _ -> None

    [<CompiledName("CoercePattern")>]
    let (|Coerce|_|)       input = match input with Comb1(CoerceOp ty,e1) -> Some(e1,ty) | _ -> None

    [<CompiledName("TypeTestPattern")>]
    let (|TypeTest|_|)       input = match input with Comb1(TypeTestOp ty,e1) -> Some(e1,ty) | _ -> None

    [<CompiledName("NewArrayPattern")>]
    let (|NewArray|_|)     input = match input with E(CombTerm(NewArrayOp ty,es)) -> Some(ty,es) | _ -> None

    [<CompiledName("AddressSetPattern")>]
    let (|AddressSet|_|)   input = match input with E(CombTerm(AddressSetOp,[e;v])) -> Some(e,v) | _ -> None

    [<CompiledName("TryFinallyPattern")>]
    let (|TryFinally|_|)   input = match input with E(CombTerm(TryFinallyOp,[e1;e2])) -> Some(e1,e2) | _ -> None

    [<CompiledName("TryWithPattern")>]
    let (|TryWith|_|)     input = match input with E(CombTerm(TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)])) -> Some(e1,v1,e2,v2,e3) | _ -> None

    [<CompiledName("VarSetPattern")>]
    let (|VarSet|_|    )   input = match input with E(CombTerm(VarSetOp,[E(VarTerm(v)); e])) -> Some(v,e) | _ -> None

    [<CompiledName("ValuePattern")>]
    let (|Value|_|)        input = match input with E(CombTerm(ValueOp (v,ty,_),_)) -> Some(v,ty) | _ -> None

    [<CompiledName("ValueObjPattern")>]
    let (|ValueObj|_|)     input = match input with E(CombTerm(ValueOp (v,_,_),_)) -> Some(v) | _ -> None

    [<CompiledName("ValueWithNamePattern")>]
    let (|ValueWithName|_|) input = 
        match input with 
        | E(CombTerm(ValueOp (v,ty,Some nm),_)) -> Some(v,ty,nm) 
        | _ -> None

    [<CompiledName("WithValuePattern")>]
    let (|WithValue|_|) input = 
        match input with 
        | E(CombTerm(WithValueOp (v,ty),[e])) -> Some(v,ty,e) 
        | _ -> None

    [<CompiledName("AddressOfPattern")>]
    let (|AddressOf|_|) input = 
        match input with 
        | Comb1(AddressOfOp,e) -> Some(e) 
        | _ -> None

    [<CompiledName("SequentialPattern")>]
    let (|Sequential|_|) input = 
        match input with 
        | Comb2(SequentialOp,e1,e2) -> Some(e1,e2) 
        | _ -> None

    [<CompiledName("ForIntegerRangeLoopPattern")>]
    let (|ForIntegerRangeLoop|_|) input = 
        match input with 
        | Comb3(ForIntegerRangeLoopOp,e1,e2,Lambda(v, e3)) -> Some(v,e1,e2,e3) 
        | _ -> None

    [<CompiledName("WhileLoopPattern")>]
    let (|WhileLoop|_|) input = 
        match input with 
        | Comb2(WhileLoopOp,e1,e2) -> Some(e1,e2) 
        | _ -> None

    [<CompiledName("PropertyGetPattern")>]
    let (|PropertyGet|_|) input = 
        match input with 
        | E(CombTerm(StaticPropGetOp pinfo,args)) -> Some(None,pinfo,args) 
        | E(CombTerm(InstancePropGetOp pinfo,obj::args)) -> Some(Some(obj),pinfo,args) 
        | _ -> None

    [<CompiledName("PropertySetPattern")>]
    let (|PropertySet|_|) input = 
        match input with 
        | E(CombTerm(StaticPropSetOp pinfo, FrontAndBack(args,v))) -> Some(None,pinfo,args,v) 
        | E(CombTerm(InstancePropSetOp pinfo, obj::FrontAndBack(args,v))) -> Some(Some(obj),pinfo,args,v) 
        | _ -> None


    [<CompiledName("FieldGetPattern")>]
    let (|FieldGet|_|)     input = 
        match input with 
        | E(CombTerm(StaticFieldGetOp finfo,[])) -> Some(None,finfo) 
        | E(CombTerm(InstanceFieldGetOp finfo,[obj])) -> Some(Some(obj),finfo) 
        | _ -> None

    [<CompiledName("FieldSetPattern")>]
    let (|FieldSet|_|)     input = 
        match input with 
        | E(CombTerm(StaticFieldSetOp finfo,[v])) -> Some(None,finfo,v) 
        | E(CombTerm(InstanceFieldSetOp finfo,[obj;v])) -> Some(Some(obj),finfo,v) 
        | _ -> None

    [<CompiledName("NewObjectPattern")>]
    let (|NewObject|_|)     input = 
        match input with 
        | E(CombTerm(NewObjectOp ty,e)) -> Some(ty,e) | _ -> None

    [<CompiledName("CallPattern")>]
    let (|Call|_|)          input = 
        match input with 
        | E(CombTerm(StaticMethodCallOp minfo,args)) -> Some(None,minfo,args) 
        | E(CombTerm(InstanceMethodCallOp minfo,(obj::args))) -> Some(Some(obj),minfo,args) 
        | _ -> None

    let (|LetRaw|_|) input = 
        match input with 
        | Comb2(LetOp,e1,e2) -> Some(e1,e2) 
        | _ -> None

    let (|LetRecRaw|_|) input = 
        match input with 
        | Comb1(LetRecOp,e1) -> Some(e1) 
        | _ -> None

    [<CompiledName("LetPattern")>]
    let (|Let|_|)input = 
        match input with 
        | LetRaw(e,Lambda(v,body)) -> Some(v,e,body) 
        | _ -> None

    let (|IteratedLambda|_|) (e: Expr) = qOneOrMoreRLinear (|Lambda|_|) e 

    let rec (|NLambdas|_|) n (e:Expr) = 
        match e with 
        | _ when n <= 0 -> Some([],e) 
        | Lambda(v,NLambdas ((-) n 1) (vs,b)) -> Some(v::vs,b)
        | _ -> None

    [<CompiledName("NewDelegatePattern")>]
    let (|NewDelegate|_|) input  = 
        match input with 
        | Comb1(NewDelegateOp(ty),e) -> 
            let nargs = (getDelegateInvoke ty).GetParameters().Length
            if nargs = 0 then 
                match e with 
                | NLambdas 1 ([_],e) -> Some(ty,[],e) // try to strip the unit parameter if there is one 
                | NLambdas 0 ([],e) -> Some(ty,[],e) 
                | _ -> None
            else
                match e with 
                | NLambdas nargs (vs,e) -> Some(ty,vs,e) 
                | _ -> None
        | _ -> None

    [<CompiledName("LetRecursivePattern")>]
    let (|LetRecursive|_|) input = 
        match input with 
        | LetRecRaw(IteratedLambda(vs1,E(CombTerm(LetRecCombOp,body::es)))) -> Some(List.zip vs1 es,body)
        | _ -> None
    
    //--------------------------------------------------------------------------
    // Getting the type of Raw quotations
    //--------------------------------------------------------------------------

    // Returns record member specified by name
    let getRecordProperty(ty,fieldName) =    
        let mems = FSharpType.GetRecordFields(ty,publicOrPrivateBindingFlags)
        match mems |> Array.tryFind (fun minfo -> minfo.Name = fieldName) with
        | Some (m) -> m
        | _ -> invalidArg  "fieldName" (String.Format(SR.GetString(SR.QmissingRecordField), ty.FullName, fieldName))

    let getUnionCaseInfo(ty,unionCaseName) =    
        let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags)
        match cases |> Array.tryFind (fun ucase -> ucase.Name = unionCaseName) with
        | Some(case) -> case
        | _ -> invalidArg  "unionCaseName" (String.Format(SR.GetString(SR.QmissingUnionCase), ty.FullName, unionCaseName))
    
    let getUnionCaseInfoField(unionCase:UnionCaseInfo,index) =    
        let fields = unionCase.GetFields() 
        if index < 0 || index >= fields.Length then invalidArg "index" (SR.GetString(SR.QinvalidCaseIndex))
        fields.[index]
 
    /// Returns type of lambda application - something like "(fun a -> ..) b"
    let rec typeOfAppliedLambda f =
        let fty = ((typeOf f):Type) 
        match fty.GetGenericArguments() with 
        | [| _; b|] -> b
        | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet))          

    /// Returns type of the Raw quotation or fails if the quotation is ill formed
    /// if 'verify' is true, verifies all branches, otherwise ignores some of them when not needed
    and typeOf<'T when 'T :> Expr> (e : 'T) : Type = 
        let (E t) = e 
        match t with 
        | VarTerm    v        -> v.Type
        | LambdaTerm (v,b)    -> mkFunTy v.Type (typeOf b)
        | HoleTerm   (ty,_)   -> ty
        | CombTerm   (c,args) -> 
            match c,args with 
            | AppOp,[f;_] -> typeOfAppliedLambda f
            | LetOp,_ -> match e with Let(_,_,b) -> typeOf b | _ -> failwith "unreachable"
            | IfThenElseOp,[_;t;_]  -> typeOf t
            | LetRecOp,_     -> match e with LetRecursive(_,b) -> typeOf b | _ -> failwith "unreachable"
            | LetRecCombOp,_        -> failwith "typeOfConst: LetRecCombOp" 
            | NewRecordOp ty,_         -> ty
            | NewUnionCaseOp unionCase,_   -> unionCase.DeclaringType
            | UnionCaseTestOp _,_ -> typeof<Boolean>
            | ValueOp (_, ty, _),_  -> ty
            | WithValueOp (_, ty),_  -> ty
            | TupleGetOp (ty,i),_ -> FSharpType.GetTupleElements(ty).[i] 
            | NewTupleOp ty,_      -> ty
            | StaticPropGetOp prop,_    -> prop.PropertyType
            | InstancePropGetOp prop,_    -> prop.PropertyType
            | StaticPropSetOp _,_   -> typeof<Unit>
            | InstancePropSetOp _,_    -> typeof<Unit>
            | InstanceFieldGetOp fld ,_   -> fld.FieldType
            | StaticFieldGetOp fld ,_   -> fld.FieldType
            | InstanceFieldSetOp _,_    -> typeof<Unit>
            | StaticFieldSetOp _,_    -> typeof<Unit>
            | NewObjectOp ctor,_   -> ctor.DeclaringType
            | InstanceMethodCallOp minfo,_   -> minfo.ReturnType |> removeVoid
            | StaticMethodCallOp minfo,_   -> minfo.ReturnType |> removeVoid
            | CoerceOp ty,_       -> ty
            | SequentialOp,[_;b]      -> typeOf b 
            | ForIntegerRangeLoopOp,_  -> typeof<Unit>
            | NewArrayOp ty,_      -> mkArrayTy ty
            | NewDelegateOp ty,_     -> ty
            | DefaultValueOp ty,_     -> ty
            | TypeTestOp _,_     -> typeof<bool>
            | QuoteOp true,[expr]        -> mkExprTy (typeOf expr)
            | QuoteOp false,[_]        -> rawExprTy
            | TryFinallyOp,[e1;_]        -> typeOf e1
            | TryWithOp,[e1;_;_]        -> typeOf e1
            | WhileLoopOp,_ 
            | VarSetOp,_
            | AddressSetOp,_ -> typeof<Unit> 
            | AddressOfOp,[expr]-> (typeOf expr).MakeByRefType()
            | (AddressOfOp | QuoteOp _ | SequentialOp | TryWithOp | TryFinallyOp | IfThenElseOp | AppOp),_ -> failwith "unreachable"


    //--------------------------------------------------------------------------
    // Constructors for building Raw quotations
    //--------------------------------------------------------------------------
      
    let mkFEN op l = E(CombTerm(op,l))
    let mkFE0 op = E(CombTerm(op,[]))
    let mkFE1 op x = E(CombTerm(op,[(x:>Expr)]))
    let mkFE2 op (x,y) = E(CombTerm(op,[(x:>Expr);(y:>Expr)]))
    let mkFE3 op (x,y,z) = E(CombTerm(op,[(x:>Expr);(y:>Expr);(z:>Expr)])  )
    let mkOp v () = v

    //--------------------------------------------------------------------------
    // Type-checked constructors for building Raw quotations
    //--------------------------------------------------------------------------
  
    // t2 is inherited from t1 / t2 implements interface t1 or t2 == t1
    let assignableFrom (t1:Type) (t2:Type) =  
        t1.IsAssignableFrom(t2)
      
    let checkTypesSR (expectedType: Type) (receivedType : Type)  name (threeHoleSR : string) =
        if (expectedType <> receivedType) then 
          invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType))

    let checkTypesWeakSR (expectedType: Type) (receivedType : Type)  name (threeHoleSR : string) = 
        if (not (assignableFrom expectedType receivedType)) then 
          invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType))
  
    let checkArgs (paramInfos: ParameterInfo[]) (args:list<Expr>) =  
        if (paramInfos.Length <> args.Length) then invalidArg "args" (SR.GetString(SR.QincorrectNumArgs))
        List.iter2
            ( fun (p:ParameterInfo) a -> checkTypesWeakSR p.ParameterType (typeOf a) "args" (SR.GetString(SR.QtmmInvalidParam))) 
            (paramInfos |> Array.toList) 
            args
                                                // todo: shouldn't this be "strong" type check? sometimes?

    let checkAssignableFrom ty1 ty2 = 
        if not (assignableFrom ty1 ty2) then invalidArg "ty2" (SR.GetString(SR.QincorrectType))

    let checkObj  (membInfo: MemberInfo) (obj: Expr) = 
        // The MemberInfo may be a property associated with a union
        // find the actual related union type
        let rec loop (ty:Type) = if FSharpType.IsUnion ty && FSharpType.IsUnion ty.BaseType then loop ty.BaseType else ty
        let declType = loop membInfo.DeclaringType
        if not (assignableFrom declType (typeOf obj)) then invalidArg "obj" (SR.GetString(SR.QincorrectInstanceType))

      
    // Checks lambda application for correctness
    let checkAppliedLambda (f, v) =
        let fty = typeOf f
        let ftyG = (if fty.IsGenericType then  fty.GetGenericTypeDefinition()  else fty)
        checkTypesSR funTyC ftyG "f" (SR.GetString(SR.QtmmExpectedFunction))
        let vty = (typeOf v)
        match fty.GetGenericArguments() with 
          | [| a; _ |] -> checkTypesSR vty a "f" (SR.GetString(SR.QtmmFunctionArgTypeMismatch))
          | _ -> invalidArg  "f" (SR.GetString(SR.QinvalidFuncType))
  
    // Returns option (by name) of a NewUnionCase type
    let getUnionCaseFields ty str =       
        let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags)
        match cases |> Array.tryFind (fun ucase -> ucase.Name = str) with
        | Some(case) -> case.GetFields()
        | _ -> invalidArg  "ty" (String.Format(SR.GetString(SR.notAUnionType), ty.FullName))
  
    let checkBind(v:Var,e) = 
        let ety = typeOf e
        checkTypesSR v.Type ety "let" (SR.GetString(SR.QtmmVarTypeNotMatchRHS))
  
    // [Correct by definition]
    let mkVar v       = E(VarTerm v )
    let mkQuote(a,isTyped)    = E(CombTerm(QuoteOp isTyped,[(a:>Expr)] ))
          
    let mkValue (v,ty) = mkFE0 (ValueOp(v,ty,None))
    let mkValueWithName (v,ty,nm) = mkFE0 (ValueOp(v,ty,Some nm))
    let mkValueWithDefn (v,ty,defn) = mkFE1 (WithValueOp(v,ty)) defn
    let mkValueG (v:'T) = mkValue(box v, typeof<'T>)
    let mkLiftedValueOpG (v, ty: System.Type) = 
        let obj = if ty.IsEnum then System.Enum.ToObject(ty, box v) else box v
        ValueOp(obj, ty, None)
    let mkUnit       () = mkValue(null, typeof<unit>)
    let mkAddressOf     v = mkFE1 AddressOfOp v
    let mkSequential  (e1,e2) = mkFE2 SequentialOp (e1,e2) 
    let mkTypeTest    (e,ty) = mkFE1 (TypeTestOp(ty)) e
    let mkVarSet    (v,e) = mkFE2 VarSetOp (mkVar(v),e)
    let mkAddressSet    (e1,e2) = mkFE2 AddressSetOp (e1,e2)
    let mkLambda(var,body) = E(LambdaTerm(var,(body:>Expr)))
    let mkTryWith(e1,v1,e2,v2,e3) = mkFE3 TryWithOp (e1,mkLambda(v1,e2),mkLambda(v2,e3))
    let mkTryFinally(e1,e2) = mkFE2 TryFinallyOp (e1,e2)
    
    let mkCoerce      (ty,x) = mkFE1 (CoerceOp ty) x
    let mkNull        (ty)   = mkFE0 (ValueOp(null,ty,None))
    
    let mkApplication v = checkAppliedLambda v; mkFE2 AppOp v 

    let mkLetRaw v =
        mkFE2 LetOp v

    let mkLetRawWithCheck ((e1,e2) as v) =
        checkAppliedLambda (e2,e1) 
        mkLetRaw v

    // Tuples
    let mkNewTupleWithType    (ty,args:Expr list) = 
        let mems = FSharpType.GetTupleElements ty |> Array.toList
        if (args.Length <> mems.Length) then invalidArg  "args" (SR.GetString(SR.QtupleLengthsDiffer))
        List.iter2(fun mt a -> checkTypesSR mt (typeOf a) "args" (SR.GetString(SR.QtmmTuple)) ) mems args
        mkFEN (NewTupleOp ty) args 
    
    let mkNewTuple (args) = 
        let ty = FSharpType.MakeTupleType(Array.map typeOf (Array.ofList args))
        mkFEN (NewTupleOp ty) args
    
    let mkTupleGet (ty,n,x) = 
        checkTypesSR ty (typeOf x) "tupleGet" (SR.GetString(SR.QtmmExprNotMatchTuple))
        let mems = FSharpType.GetTupleElements ty 
        if (n < 0 || mems.Length <= n) then invalidArg  "n" (SR.GetString(SR.QtupleAccessOutOfRange))
        mkFE1 (TupleGetOp (ty,n)) x
    
    // Records
    let mkNewRecord (ty,args:list<Expr>) = 
        let mems = FSharpType.GetRecordFields(ty,publicOrPrivateBindingFlags) 
        if (args.Length <> mems.Length) then invalidArg  "args" (SR.GetString(SR.QincompatibleRecordLength))
        List.iter2 (fun (minfo:PropertyInfo) a -> checkTypesSR minfo.PropertyType (typeOf a) "recd" (SR.GetString(SR.QtmmIncorrectArgForRecord))) (Array.toList mems) args
        mkFEN (NewRecordOp ty) args
      
      
    // Discriminated unions        
    let mkNewUnionCase (unionCase:UnionCaseInfo,args:list<Expr>) = 
        if Unchecked.defaultof<UnionCaseInfo> = unionCase then raise (new ArgumentNullException())
        let sargs = unionCase.GetFields()
        if (args.Length <> sargs.Length) then invalidArg  "args" (SR.GetString(SR.QunionNeedsDiffNumArgs))
        List.iter2 (fun (minfo:PropertyInfo) a  -> checkTypesSR minfo.PropertyType (typeOf a) "sum" (SR.GetString(SR.QtmmIncorrectArgForUnion))) (Array.toList sargs) args
        mkFEN (NewUnionCaseOp unionCase) args
        
    let mkUnionCaseTest (unionCase:UnionCaseInfo,expr) = 
        if Unchecked.defaultof<UnionCaseInfo> = unionCase then raise (new ArgumentNullException())
        checkTypesSR unionCase.DeclaringType (typeOf expr) "UnionCaseTagTest" (SR.GetString(SR.QtmmExprTypeMismatch))
        mkFE1 (UnionCaseTestOp unionCase) expr

    // Conditional etc..
    let mkIfThenElse (e,t,f) = 
        checkTypesSR (typeOf t) (typeOf f) "cond" (SR.GetString(SR.QtmmTrueAndFalseMustMatch))
        checkTypesSR (typeof<Boolean>) (typeOf e) "cond" (SR.GetString(SR.QtmmCondMustBeBool))
        mkFE3 IfThenElseOp (e,t,f)               
        
    let mkNewArray (ty,args) = 
        List.iter (fun a -> checkTypesSR ty (typeOf a) "newArray" (SR.GetString(SR.QtmmInitArray))) args
        mkFEN (NewArrayOp ty) args
        
    let mkInstanceFieldGet(obj,finfo:FieldInfo) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        match finfo.IsStatic with 
        | false -> 
            checkObj finfo obj
            mkFE1 (InstanceFieldGetOp finfo) obj
        | true -> invalidArg  "finfo" (SR.GetString(SR.QstaticWithReceiverObject))
      
    let mkStaticFieldGet    (finfo:FieldInfo) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        match finfo.IsStatic with 
        | true -> mkFE0 (StaticFieldGetOp finfo) 
        | false -> invalidArg  "finfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
      
    let mkStaticFieldSet (finfo:FieldInfo,value:Expr) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        checkTypesSR (typeOf value) finfo.FieldType "value" (SR.GetString(SR.QtmmBadFieldType))
        match finfo.IsStatic with 
        | true -> mkFE1 (StaticFieldSetOp finfo) value
        | false -> invalidArg  "finfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
      
    let mkInstanceFieldSet (obj,finfo:FieldInfo,value:Expr) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        checkTypesSR (typeOf value) finfo.FieldType "value" (SR.GetString(SR.QtmmBadFieldType))
        match finfo.IsStatic with 
        | false -> 
            checkObj finfo obj
            mkFE2 (InstanceFieldSetOp finfo) (obj,value)
        | true -> invalidArg  "finfo" (SR.GetString(SR.QstaticWithReceiverObject))
      
    let mkCtorCall (ci:ConstructorInfo,args:list<Expr>) =
        if Unchecked.defaultof<ConstructorInfo> = ci then raise (new ArgumentNullException())
        checkArgs (ci.GetParameters()) args
        mkFEN (NewObjectOp ci) args

    let mkDefaultValue (ty:Type) =
        mkFE0 (DefaultValueOp ty) 

    let mkStaticPropGet (pinfo:PropertyInfo,args:list<Expr>) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanRead) then invalidArg  "pinfo" (SR.GetString(SR.QreadingSetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetGetMethod(true).IsStatic with 
        | true -> mkFEN (StaticPropGetOp  pinfo) args
        | false -> invalidArg  "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject))

    let mkInstancePropGet (obj,pinfo:PropertyInfo,args:list<Expr>) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanRead) then invalidArg  "pinfo" (SR.GetString(SR.QreadingSetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetGetMethod(true).IsStatic with 
        | false -> 
            checkObj pinfo obj
            mkFEN (InstancePropGetOp pinfo) (obj::args)
        | true -> invalidArg  "pinfo" (SR.GetString(SR.QstaticWithReceiverObject))
          
    let mkStaticPropSet (pinfo:PropertyInfo,args:list<Expr>,value:Expr) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanWrite) then invalidArg  "pinfo" (SR.GetString(SR.QwritingGetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetSetMethod(true).IsStatic with 
        | true -> mkFEN (StaticPropSetOp pinfo) (args@[value])
        | false -> invalidArg  "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
          
    let mkInstancePropSet (obj,pinfo:PropertyInfo,args:list<Expr>,value:Expr) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanWrite) then invalidArg  "pinfo" (SR.GetString(SR.QwritingGetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetSetMethod(true).IsStatic with 
        | false -> 
            checkObj pinfo obj
            mkFEN (InstancePropSetOp pinfo) (obj::(args@[value]))
        | true -> invalidArg  "pinfo" (SR.GetString(SR.QstaticWithReceiverObject))
          
    let mkInstanceMethodCall (obj,minfo:MethodInfo,args:list<Expr>) =
        if Unchecked.defaultof<MethodInfo> = minfo then raise (new ArgumentNullException())
        checkArgs (minfo.GetParameters()) args
        match minfo.IsStatic with 
        | false -> 
            checkObj minfo obj
            mkFEN (InstanceMethodCallOp minfo) (obj::args)
        | true -> invalidArg  "minfo" (SR.GetString(SR.QstaticWithReceiverObject))
    
    let mkStaticMethodCall (minfo:MethodInfo,args:list<Expr>) =
        if Unchecked.defaultof<MethodInfo> = minfo then raise (new ArgumentNullException())
        checkArgs (minfo.GetParameters()) args
        match minfo.IsStatic with 
        | true -> mkFEN (StaticMethodCallOp minfo) args
        | false -> invalidArg  "minfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
    
    let mkForLoop (v:Var,lowerBound,upperBound,body) = 
        checkTypesSR (typeof<int>) (typeOf lowerBound) "lowerBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt))
        checkTypesSR (typeof<int>) (typeOf upperBound) "upperBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt))
        checkTypesSR (typeof<int>) (v.Type) "for" (SR.GetString(SR.QtmmLoopBodyMustBeLambdaTakingInteger))
        mkFE3 ForIntegerRangeLoopOp (lowerBound, upperBound, mkLambda(v,body))
      
    let mkWhileLoop (guard,body) = 
        checkTypesSR (typeof<bool>) (typeOf guard) "guard" (SR.GetString(SR.QtmmGuardMustBeBool))
        checkTypesSR (typeof<Unit>) (typeOf body) "body" (SR.GetString(SR.QtmmBodyMustBeUnit))
        mkFE2 (WhileLoopOp) (guard,body)
    
    let mkNewDelegate (ty,e) = 
        let mi = getDelegateInvoke ty
        let ps = mi.GetParameters()
        let dlfun = Array.foldBack (fun (p:ParameterInfo) rty -> mkFunTy p.ParameterType rty) ps mi.ReturnType
        checkTypesSR dlfun (typeOf e) "ty" (SR.GetString(SR.QtmmFunTypeNotMatchDelegate))
        mkFE1 (NewDelegateOp ty) e
    
    let mkLet (v,e,b) = 
        checkBind (v,e);
        mkLetRaw (e,mkLambda(v,b))

    //let mkLambdas(vs,b) = mkRLinear mkLambdaRaw (vs,(b:>Expr))
    let mkTupledApplication (f,args) = 
        match args with 
        | [] -> mkApplication (f,mkUnit())
        | [x] -> mkApplication (f,x)
        | _ -> mkApplication (f,mkNewTuple args)
        
    let mkApplications(f: Expr,es:list<list<Expr>>) = mkLLinear mkTupledApplication (f,es)
    
    let mkIteratedLambdas(vs,b) = mkRLinear  mkLambda (vs,b)
    
    let mkLetRecRaw v = mkFE1 LetRecOp v
    let mkLetRecCombRaw v = mkFEN LetRecCombOp v
    let mkLetRec (ves:(Var*Expr) list,body) = 
        List.iter checkBind ves;
        let vs,es = List.unzip ves 
        mkLetRecRaw(mkIteratedLambdas (vs,mkLetRecCombRaw (body::es)))

    let ReflectedDefinitionsResourceNameBase = "ReflectedDefinitions"

    //-------------------------------------------------------------------------
    // General Method Binder

    /// Usually functions in modules are not overloadable so having name is enough to recover the function.
    /// However type extensions break this assumption - it is possible to have multiple extension methods in module that will have the same name.
    /// This type is used to denote different binding results so we can distinguish the latter case and retry binding later when more information is available.
    [<NoEquality; NoComparison>]
    type ModuleDefinitionBindingResult<'T, 'R> =
        | Unique of 'T
        | Ambiguous of 'R

    let typeEquals     (s:Type) (t:Type) = s.Equals(t)
    let typesEqual (ss:Type list) (tt:Type list) =
      (ss.Length = tt.Length) && List.forall2 typeEquals ss tt

    let instFormal (typarEnv: Type[]) (ty:Instantiable<'T>) = ty (fun i -> typarEnv.[i])

    let getGenericArguments(tc:Type) = 
        if tc.IsGenericType then tc.GetGenericArguments() else [| |] 

    let getNumGenericArguments(tc:Type) = 
        if tc.IsGenericType then tc.GetGenericArguments().Length else 0
    
    let bindMethodBySearch (parentT:Type,nm,marity,argtys,rty) =
        let methInfos = parentT.GetMethods(staticOrInstanceBindingFlags) |> Array.toList 
        // First, filter on name, if unique, then binding "done" 
        let tyargTs = getGenericArguments(parentT) 
        let methInfos = methInfos |> List.filter (fun methInfo -> methInfo.Name = nm)
        match methInfos with 
        | [methInfo] -> 
            methInfo
        | _ ->
            // Second, type match. 
            let select (methInfo:MethodInfo) =
                // mref implied Types 
                let mtyargTIs = if methInfo.IsGenericMethod then methInfo.GetGenericArguments() else [| |] 
                if mtyargTIs.Length  <> marity then false (* method generic arity mismatch *) else
                let typarEnv = (Array.append tyargTs mtyargTIs) 
                let argTs = argtys |> List.map (instFormal typarEnv) 
                let resT  = instFormal typarEnv rty 
                
                // methInfo implied Types 
                let haveArgTs = 
                    let parameters = Array.toList (methInfo.GetParameters()) 
                    parameters |> List.map (fun param -> param.ParameterType) 
                let haveResT  = methInfo.ReturnType 
                // check for match 
                if argTs.Length <> haveArgTs.Length then false (* method argument length mismatch *) else
                let res = typesEqual (resT::argTs) (haveResT::haveArgTs) 
                res
            // return MethodInfo for (generic) type's (generic) method 
            match List.tryFind select methInfos with
            | None          -> raise <| System.InvalidOperationException (SR.GetString SR.QcannotBindToMethod) 
            | Some methInfo -> methInfo 

    let bindMethodHelper (parentT: Type, nm,marity,argtys,rty) =
      if isNull parentT then invalidArg "parentT" (SR.GetString(SR.QparentCannotBeNull))
      if marity = 0 then 
          let tyargTs = if parentT.IsGenericType then parentT.GetGenericArguments() else [| |] 
          let argTs = Array.ofList (List.map (instFormal tyargTs) argtys) 
          let resT  = instFormal tyargTs rty 
          let methInfo = 
              try 
#if FX_PORTABLE_OR_NETSTANDARD
                 match parentT.GetMethod(nm,argTs) with 
#else              
                 match parentT.GetMethod(nm,staticOrInstanceBindingFlags,null,argTs,null) with 
#endif                 
                 | null -> None
                 | res -> Some(res)
               with :? AmbiguousMatchException -> None 
          match methInfo with 
          | Some methInfo when (typeEquals resT methInfo.ReturnType) -> methInfo
          | _ -> bindMethodBySearch(parentT,nm,marity,argtys,rty)
      else 
          bindMethodBySearch(parentT,nm,marity,argtys,rty)

    let bindModuleProperty (ty:Type,nm) = 
        match ty.GetProperty(nm,staticBindingFlags) with
        | null -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString()))
        | res -> res
    
    // tries to locate unique function in a given type
    // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution
    let bindModuleFunction (ty:Type,nm) = 
        match ty.GetMethods(staticBindingFlags) |> Array.filter (fun mi -> mi.Name = nm) with 
        | [||] -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString()))
        | [| res |] -> Some res
        | _ -> None
    
    let bindModuleFunctionWithCallSiteArgs (ty:Type, nm, argTypes : Type list, tyArgs : Type list) = 
        let argTypes = List.toArray argTypes
        let tyArgs = List.toArray tyArgs
        let methInfo = 
            try 
#if FX_PORTABLE_OR_NETSTANDARD
                match ty.GetMethod(nm, argTypes) with 
#else             
                match ty.GetMethod(nm,staticOrInstanceBindingFlags,null, argTypes,null) with 
#endif                 
                | null -> None
                | res -> Some(res)
            with :? AmbiguousMatchException -> None 
        match methInfo with 
        | Some methInfo -> methInfo
        | _ ->
            // narrow down set of candidates by removing methods with a different name\number of arguments\number of type parameters
            let candidates = 
                ty.GetMethods(staticBindingFlags)
                |> Array.filter(fun mi ->
                    mi.Name = nm &&
                    mi.GetParameters().Length = argTypes.Length &&
                    let methodTyArgCount = if mi.IsGenericMethod then mi.GetGenericArguments().Length else 0
                    methodTyArgCount = tyArgs.Length
                )
            let fail() = raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString()))
            match candidates with
            | [||] -> fail()
            | [| solution |] -> solution
            | candidates ->
                let solution =
                    // no type arguments - just perform pairwise comparison of type in methods signature and argument type from the callsite
                    if tyArgs.Length = 0 then
                        candidates
                        |> Array.tryFind(fun mi ->
                            let paramTys = mi.GetParameters() |> Array.map (fun pi -> pi.ParameterType)
                            Array.forall2 (=) argTypes paramTys
                        )
                    else
                        let FAIL = -1
                        let MATCH = 2
                        let GENERIC_MATCH = 1
                        // if signature has type arguments then it is possible to have several candidates like
                        // - Foo(_ : 'a)
                        // - Foo(_ : int)
                        // and callsite
                        // - Foo<int>(_ : int)
                        // here instantiation of first method we'll have two similar signatures
                        // however compiler will pick second one and we must do the same.

                        // here we compute weights for every signature
                        // for every parameter type:
                        // - non-matching with actual argument type stops computation and return FAIL as the final result
                        // - exact match with actual argument type adds MATCH value to the final result
                        // - parameter type is generic that after instantiation matches actual argument type adds GENERIC_MATCH to the final result
                        // - parameter type is generic that after instantiation doesn't actual argument type stops computation and return FAIL as the final result
                        let weight (mi : MethodInfo) =
                            let parameters = mi.GetParameters()
                            let rec iter i acc = 
                                if i >= argTypes.Length then acc
                                else
                                let param = parameters.[i]
                                if param.ParameterType.IsGenericParameter then
                                    let actualTy = tyArgs.[param.ParameterType.GenericParameterPosition]
                                    if actualTy = argTypes.[i] then iter (i + 1) (acc + GENERIC_MATCH) else FAIL
                                else
                                    if param.ParameterType = argTypes.[i] then iter (i + 1) (acc + MATCH) else FAIL
                            iter 0 0
                        let solution, weight = 
                            candidates 
                            |> Array.map (fun mi -> mi, weight mi)
                            |> Array.maxBy snd
                        if weight = FAIL then None
                        else Some solution
                match solution with
                | Some mi -> mi
                | None -> fail() 
            
    let mkNamedType (tc:Type,tyargs)  =
        match  tyargs with 
        | [] -> tc
        | _ -> tc.MakeGenericType(Array.ofList tyargs)

    let inline checkNonNullResult (arg:string,err:string) y = 
        match box y with 
        | null -> raise (new ArgumentNullException(arg,err)) 
        | _ -> y

    let inst (tyargs:Type list) (i: Instantiable<'T>) = i (fun idx -> tyargs.[idx]) // Note, O(n) looks, but #tyargs is always small
    
    let bindPropBySearchIfCandidateIsNull (ty : Type) propName retType argTypes candidate = 
        match candidate with
        | null ->
            let props = 
                ty.GetProperties(staticOrInstanceBindingFlags)
                |> Array.filter (fun pi -> 
                    let paramTypes = getTypesFromParamInfos (pi.GetIndexParameters())
                    pi.Name = propName && 
                    pi.PropertyType = retType && 
                    Array.length argTypes = paramTypes.Length && 
                    Array.forall2 (=) argTypes paramTypes
                    )
            match props with
            | [| pi |] -> pi
            | _ -> null
        | pi -> pi
    
    let bindCtorBySearchIfCandidateIsNull (ty : Type) argTypes candidate = 
        match candidate with
        | null -> 
            let ctors = 
                ty.GetConstructors(instanceBindingFlags)
                |> Array.filter (fun ci ->
                    let paramTypes = getTypesFromParamInfos (ci.GetParameters())
                    Array.length argTypes = paramTypes.Length &&
                    Array.forall2 (=) argTypes paramTypes
                )
            match ctors with
            | [| ctor |] -> ctor
            | _ -> null
        | ctor -> ctor
                  

    let bindProp (tc,propName,retType,argTypes,tyargs) =
        // We search in the instantiated type, rather than searching the generic type.
        let typ = mkNamedType(tc,tyargs)
        let argtyps : Type list = argTypes |> inst tyargs
        let retType : Type = retType |> inst tyargs |> removeVoid
#if FX_PORTABLE_OR_NETSTANDARD
        try 
            typ.GetProperty(propName, staticOrInstanceBindingFlags) 
        with :? AmbiguousMatchException -> null // more than one property found with the specified name and matching binding constraints - return null to initiate manual search
        |> bindPropBySearchIfCandidateIsNull typ propName retType (Array.ofList argtyps)
        |> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg
#else        
        typ.GetProperty(propName, staticOrInstanceBindingFlags, null, retType, Array.ofList argtyps, null) |> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg
#endif
    let bindField (tc,fldName,tyargs) =
        let typ = mkNamedType(tc,tyargs)
        typ.GetField(fldName,staticOrInstanceBindingFlags) |> checkNonNullResult ("fldName", String.Format(SR.GetString(SR.QfailedToBindField), fldName))  // fxcop may not see "fldName" as an arg

    let bindGenericCctor (tc:Type) =
        tc.GetConstructor(staticBindingFlags,null,[| |],null) 
        |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))  

    let bindGenericCtor (tc:Type,argTypes:Instantiable<Type list>) =
        let argtyps =  instFormal (getGenericArguments tc) argTypes
#if FX_PORTABLE_OR_NETSTANDARD
        let argTypes = Array.ofList argtyps
        tc.GetConstructor(argTypes) 
        |> bindCtorBySearchIfCandidateIsNull tc argTypes
        |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))  
#else        
        tc.GetConstructor(instanceBindingFlags,null,Array.ofList argtyps,null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))  
#endif

    let bindCtor (tc,argTypes:Instantiable<Type list>,tyargs) =
        let typ = mkNamedType(tc,tyargs)
        let argtyps = argTypes |> inst tyargs
#if FX_PORTABLE_OR_NETSTANDARD
        let argTypes = Array.ofList argtyps
        typ.GetConstructor(argTypes) 
        |> bindCtorBySearchIfCandidateIsNull typ argTypes
        |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) 
#else        
        typ.GetConstructor(instanceBindingFlags,null,Array.ofList argtyps,null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) 
#endif

    let chop n xs =
        if n < 0 then invalidArg "n" (SR.GetString(SR.inputMustBeNonNegative))
        let rec split l = 
            match l with 
            | 0,xs    -> [],xs
            | n,x::xs -> let front,back = split (n-1,xs)
                         x::front,back
            | _,[]    -> failwith "List.chop: not enough elts list"
        split (n,xs)

    let instMeth (ngmeth: MethodInfo, methTypeArgs) = 
        if ngmeth.GetGenericArguments().Length = 0 then ngmeth(* non generic *) 
        else ngmeth.MakeGenericMethod(Array.ofList methTypeArgs) 

    let bindGenericMeth (tc:Type,argTypes : list<Instantiable<Type>>,retType,methName,numMethTyargs) =
        bindMethodHelper(tc,methName,numMethTyargs,argTypes,retType) 

    let bindMeth ((tc:Type,argTypes : list<Instantiable<Type>>,retType,methName,numMethTyargs),tyargs) =
        let ntyargs = tc.GetGenericArguments().Length 
        let enclTypeArgs,methTypeArgs = chop ntyargs tyargs
        let ty = mkNamedType(tc,enclTypeArgs)
        let ngmeth = bindMethodHelper(ty,methName,numMethTyargs,argTypes,retType) 
        instMeth(ngmeth,methTypeArgs)

    let pinfoIsStatic (pinfo:PropertyInfo) = 
        if pinfo.CanRead then pinfo.GetGetMethod(true).IsStatic
        elif pinfo.CanWrite then pinfo.GetSetMethod(true).IsStatic
        else false
        
    //--------------------------------------------------------------------------
    // Unpickling
    //--------------------------------------------------------------------------

    module SimpleUnpickle = 

        [<NoEquality; NoComparison>]
        type InputState = 
          { is: ByteStream; 
            istrings: string[];
            localAssembly: System.Reflection.Assembly 
            referencedTypeDefs: Type[] }

        let u_byte_as_int st = st.is.ReadByte() 

        let u_bool st = let b = u_byte_as_int st in (b = 1) 
        let u_void (_: InputState) = ()
        let u_unit (_: InputState) = ()
        let prim_u_int32 st = 
            let b0 =  (u_byte_as_int st)
            let b1 =  (u_byte_as_int st)
            let b2 =  (u_byte_as_int st)
            let b3 =  (u_byte_as_int st)
            b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24)

        let u_int32 st = 
            let b0 = u_byte_as_int st 
            if b0 <= 0x7F then b0 
            elif b0 <= 0xbf then 
                let b0 = b0 &&& 0x7f 
                let b1 = (u_byte_as_int st) 
                (b0 <<< 8) ||| b1
            else  
                prim_u_int32 st

        let u_bytes st = 
            let n = u_int32 st 
            st.is.ReadBytes(n)

        let prim_u_string st = 
            let len =  (u_int32 st) 
            st.is.ReadUtf8BytesAsString(len)

        let u_int    st = u_int32 st
        let u_sbyte  st = sbyte (u_int32 st)
        let u_byte   st = byte (u_byte_as_int st)
        let u_int16  st = int16 (u_int32 st)
        let u_uint16 st = uint16 (u_int32 st)
        let u_uint32 st = uint32 (u_int32 st)
        let u_int64  st = 
            let b1 = int64 (u_int32 st) &&& 0xFFFFFFFFL 
            let b2 = int64 (u_int32 st) 
            b1 ||| (b2 <<< 32)
        let u_uint64  st = uint64 (u_int64 st)
        let u_double st = System.BitConverter.ToDouble(System.BitConverter.GetBytes(u_int64 st),0)
        let u_float32 st = System.BitConverter.ToSingle(System.BitConverter.GetBytes(u_int32 st),0)
        let u_char st = char (int32 (u_uint16 st))
        let inline u_tup2 p1 p2 st = let a = p1 st in let b = p2 st in (a,b)
        let inline u_tup3 p1 p2 p3 st =
            let a = p1 st in let b = p2 st in let c = p3 st in (a,b,c)
        let inline u_tup4 p1 p2 p3 p4 st =
            let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in (a,b,c,d)
        let inline u_tup5 p1 p2 p3 p4 p5 st =
            let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in (a,b,c,d,e)
        let u_uniq (tbl: _ array) st = 
            let n = u_int st 
            if n < 0 || n >= tbl.Length then failwith ("u_uniq: out of range, n = "+string n+ ", sizeof(tab) = " + string tbl.Length); 
            tbl.[n]
        let u_string st = u_uniq st.istrings st

        let rec u_list_aux f acc st = 
            let tag = u_byte_as_int st 
            match tag with
            | 0 -> List.rev acc
            | 1 -> let a = f st in u_list_aux f (a::acc) st 
            | n -> failwith ("u_list: found number " + string n)
        let u_list f st = u_list_aux f [] st
         
        let unpickleObj localAssembly referencedTypeDefs u phase2bytes =
            let phase2data = 
                let st2 = 
                   { is = new ByteStream(phase2bytes,0,phase2bytes.Length)
                     istrings = [| |]
                     localAssembly=localAssembly
                     referencedTypeDefs=referencedTypeDefs  }
                u_tup2 (u_list prim_u_string) u_bytes st2 
            let stringTab,phase1bytes = phase2data 
            let st1 = 
               { is = new ByteStream(phase1bytes,0,phase1bytes.Length)
                 istrings = Array.ofList stringTab
                 localAssembly=localAssembly
                 referencedTypeDefs=referencedTypeDefs  } 
            let res = u st1 
            res 

    open SimpleUnpickle

    let decodeFunTy args =
        match args with 
        | [d;r] -> funTyC.MakeGenericType([| d; r |])
        | _ -> invalidArg "args" (SR.GetString(SR.QexpectedTwoTypes))

    let decodeArrayTy n (tys: Type list) = 
        match tys with
        | [ty] -> if (n = 1) then ty.MakeArrayType() else ty.MakeArrayType(n)  
                  // typeof<int>.MakeArrayType(1) returns "Int[*]" but we need "Int[]"
        | _ -> invalidArg "tys" (SR.GetString(SR.QexpectedOneType))
        
    let mkNamedTycon (tcName,ass:Assembly) =
        match ass.GetType(tcName) with 
        | null  -> 
            // For some reason we can get 'null' returned here even when a type with the right name exists... Hence search the slow way...
            match (ass.GetTypes() |> Array.tryFind (fun a -> a.FullName = tcName)) with 
            | Some ty -> ty
            | None -> invalidArg "tcName" (String.Format(SR.GetString(SR.QfailedToBindTypeInAssembly), tcName, ass.FullName)) // "Available types are:\n%A" tcName ass (ass.GetTypes() |> Array.map (fun a -> a.FullName))
        | ty -> ty

    let decodeNamedTy tc tsR = mkNamedType(tc,tsR)

    let mscorlib = typeof<System.Int32>.Assembly
    let u_assref st = u_string st 
    let decodeAssemblyRef st a =
        if a = "" then mscorlib
        elif a = "." then st.localAssembly 
        else 
#if FX_RESHAPED_REFLECTION
            match System.Reflection.Assembly.Load(AssemblyName(a)) with 
#else
            match System.Reflection.Assembly.Load(a) with 
#endif
            | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString()))
            | ass -> ass
        
    let u_NamedType st = 
        let a,b = u_tup2 u_string u_assref st 
        let mutable idx = 0
        // From FSharp.Core for F# 4.0+ (4.4.0.0+), referenced type definitions can be integer indexes into a table of type definitions provided on quotation 
        // deserialization, avoiding the need for System.Reflection.Assembly.Load
        if System.Int32.TryParse(a, &idx) && b = ""  then
            st.referencedTypeDefs.[idx]
        else 
            // escape commas found in type name, which are not already escaped
            // '\' is not valid in a type name except as an escape character, so logic can be pretty simple
            let escapedTcName = System.Text.RegularExpressions.Regex.Replace(a, @"(?<!\\),", @"\,")
            let assref = decodeAssemblyRef st b
            mkNamedTycon (escapedTcName, assref)

    let u_tyconstSpec st = 
      let tag = u_byte_as_int st 
      match tag with 
      | 1 -> u_unit      st |> (fun () -> decodeFunTy) 
      | 2 -> u_NamedType st |> decodeNamedTy 
      | 3 -> u_int       st |> decodeArrayTy
      | _ -> failwith "u_tyconstSpec" 

    let appL fs env = List.map (fun f -> f env) fs
    
    let rec u_dtype st : (int -> Type) -> Type = 
      let tag = u_byte_as_int st 
      match tag with 
      | 0 -> u_int                              st |> (fun x env     -> env(x)) 
      | 1 -> u_tup2 u_tyconstSpec (u_list u_dtype) st |> (fun (a,b) env -> a (appL b env))
      | _ -> failwith "u_dtype" 

    let u_dtypes st = let a = u_list u_dtype st in appL a 

    let (|NoTyArgs|)input = match input with [] -> () | _ -> failwith "incorrect number of arguments during deserialization"
    let (|OneTyArg|)input = match input with [x] -> x | _ -> failwith "incorrect number of arguments during deserialization"
    
    [<NoEquality; NoComparison>]
    type BindingEnv = 
        { /// Mapping from variable index to Var object for the variable
          vars : Map<int,Var>
          /// The number of indexes in the mapping
          varn: int
          /// The active type instantiation for generic type parameters
          typeInst : int -> Type }

    let addVar env v = 
        { env with vars = env.vars.Add(env.varn,v); varn=env.varn+1 }

    let mkTyparSubst (tyargs:Type[]) =
        let n = tyargs.Length 
        fun idx -> 
          if idx < n then tyargs.[idx]
          else raise <| System.InvalidOperationException (SR.GetString(SR.QtypeArgumentOutOfRange))

    let envClosed (spliceTypes:Type[])  =
        { vars = Map.empty;
          varn = 0
          typeInst = mkTyparSubst spliceTypes }

    type Bindable<'T> = BindingEnv -> 'T
    
    let rec u_Expr st = 
        let tag = u_byte_as_int st 
        match tag with 
        | 0 -> u_tup3 u_constSpec u_dtypes (u_list u_Expr) st 
                |> (fun (a,b,args) (env:BindingEnv) -> 
                    let args = List.map (fun e -> e env) args
                    let a =
                        match a with
                        | Unique v -> v
                        | Ambiguous f ->
                            let argTys = List.map typeOf args
                            f argTys
                    let tyargs = b env.typeInst 
                    E(CombTerm(a tyargs, args ))) 
        | 1 -> let x = u_VarRef st 
               (fun env -> E(VarTerm (x env)))
        | 2 -> let a = u_VarDecl st
               let b = u_Expr st
               (fun env -> let v = a env in E(LambdaTerm(v,b (addVar env v))))
        | 3 -> let a = u_dtype st
               let idx = u_int st
               (fun env -> E(HoleTerm(a env.typeInst , idx)))
        | 4 -> let a = u_Expr st
               (fun env -> mkQuote(a env, true))
        | 5 -> let a = u_Expr st
               let attrs = u_list u_Expr st
               (fun env -> let e = (a env) in EA(e.Tree,(e.CustomAttributes @ List.map (fun attrf -> attrf env) attrs)))
        | 6 -> let a = u_dtype st
               (fun env -> mkVar(Var.Global("this", a env.typeInst)))
        | 7 -> let a = u_Expr st
               (fun env -> mkQuote(a env, false))
        | _ -> failwith "u_Expr"

    and u_VarDecl st = 
        let s,b,mut = u_tup3 u_string u_dtype u_bool st 
        (fun env -> new Var(s, b env.typeInst, mut))

    and u_VarRef st = 
        let i = u_int st 
        (fun env -> env.vars.[i])

    and u_RecdField st = 
        let ty,nm = u_tup2 u_NamedType u_string st  
        (fun tyargs -> getRecordProperty(mkNamedType(ty,tyargs),nm)) 

    and u_UnionCaseInfo st = 
        let ty,nm = u_tup2 u_NamedType u_string st  
        (fun tyargs -> getUnionCaseInfo(mkNamedType(ty,tyargs),nm)) 

    and u_UnionCaseField st = 
        let case,i = u_tup2 u_UnionCaseInfo u_int st  
        (fun tyargs -> getUnionCaseInfoField(case tyargs,i))

    and u_ModuleDefn st = 
        let (ty,nm,isProp) = u_tup3 u_NamedType u_string u_bool st 
        if isProp then Unique(StaticPropGetOp(bindModuleProperty(ty,nm)))
        else 
        match bindModuleFunction(ty, nm) with
        | Some mi -> Unique(StaticMethodCallOp(mi))
        | None -> Ambiguous(fun argTypes tyargs -> StaticMethodCallOp(bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs)))

    and u_MethodInfoData st = 
        u_tup5 u_NamedType (u_list u_dtype) u_dtype u_string u_int st
            
    and u_PropInfoData st = 
        u_tup4 u_NamedType u_string u_dtype u_dtypes  st
        
    and u_CtorInfoData st =
        u_tup2 u_NamedType u_dtypes st
    
    and u_MethodBase st = 
        let tag = u_byte_as_int st 
        match tag with 
        | 0 -> 
            match u_ModuleDefn st with 
            | Unique(StaticMethodCallOp(minfo)) -> (minfo :> MethodBase)
            | Unique(StaticPropGetOp(pinfo)) -> (pinfo.GetGetMethod(true) :> MethodBase)
            | Ambiguous(_) -> raise (System.Reflection.AmbiguousMatchException())
            | _ -> failwith "unreachable"
        | 1 -> 
            let ((tc,_,_,methName,_) as data) = u_MethodInfoData st
            if methName = ".cctor" then 
                let cinfo = bindGenericCctor tc
                (cinfo :> MethodBase)
            else
                let minfo = bindGenericMeth(data)
                (minfo :> MethodBase)
        | 2 -> 
            let data = u_CtorInfoData st
            let cinfo = bindGenericCtor(data) in 
            (cinfo :> MethodBase)
        | _ -> failwith "u_MethodBase" 

      
    and u_constSpec st = 
        let tag = u_byte_as_int st 
        if tag = 1 then
            let bindModuleDefn r tyargs = 
                match r with
                | StaticMethodCallOp(minfo) -> StaticMethodCallOp(instMeth(minfo,tyargs))
                // OK to throw away the tyargs here since this only non-generic values in modules get represented by static properties
                | x -> x                
            match u_ModuleDefn st with
            | Unique(r) -> Unique(bindModuleDefn r)
            | Ambiguous(f) -> Ambiguous(fun argTypes tyargs -> bindModuleDefn (f argTypes tyargs) tyargs) 
        else
        let constSpec = 
            match tag with 
            | 0 -> u_void       st |> (fun () NoTyArgs -> IfThenElseOp)
            | 2 -> u_void            st |> (fun () NoTyArgs -> LetRecOp)
            | 3 -> u_NamedType        st |> (fun x tyargs -> NewRecordOp (mkNamedType(x,tyargs)))
            | 4 -> u_RecdField       st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs))
            | 5 -> u_UnionCaseInfo   st |> (fun unionCase tyargs -> NewUnionCaseOp(unionCase tyargs))
            | 6 -> u_UnionCaseField  st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs) )
            | 7 -> u_UnionCaseInfo   st |> (fun unionCase tyargs -> UnionCaseTestOp(unionCase tyargs))
            | 8 -> u_void          st |> (fun () (OneTyArg(tyarg)) -> NewTupleOp tyarg)
            | 9 -> u_int           st |> (fun x (OneTyArg(tyarg)) -> TupleGetOp (tyarg,x))
            // Note, these get type args because they may be the result of reading literal field constants
            | 11 -> u_bool         st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 12 -> u_string       st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 13 -> u_float32      st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 14 -> u_double       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 15 -> u_char         st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 16 -> u_sbyte        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 17 -> u_byte         st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 18 -> u_int16        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 19 -> u_uint16       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 20 -> u_int32        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 21 -> u_uint32       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 22 -> u_int64        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 23 -> u_uint64       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 24 -> u_void         st |> (fun () NoTyArgs -> mkLiftedValueOpG ((), typeof<unit>))
            | 25 -> u_PropInfoData st |> (fun (a,b,c,d) tyargs -> let pinfo = bindProp(a,b,c,d,tyargs) in if pinfoIsStatic pinfo then StaticPropGetOp(pinfo) else InstancePropGetOp(pinfo))
            | 26 -> u_CtorInfoData st |> (fun (a,b) tyargs  -> NewObjectOp (bindCtor(a,b,tyargs)))
            | 28 -> u_void         st |> (fun () (OneTyArg(ty)) -> CoerceOp ty)
            | 29 -> u_void         st |> (fun () NoTyArgs -> SequentialOp)
            | 30 -> u_void         st |> (fun () NoTyArgs -> ForIntegerRangeLoopOp)
            | 31 -> u_MethodInfoData st |> (fun p tyargs -> let minfo = bindMeth(p,tyargs) in if minfo.IsStatic then StaticMethodCallOp(minfo) else InstanceMethodCallOp(minfo))
            | 32 -> u_void           st |> (fun () (OneTyArg(ty)) -> NewArrayOp ty)
            | 33 -> u_void           st |> (fun () (OneTyArg(ty)) -> NewDelegateOp ty)
            | 34 -> u_void           st |> (fun () NoTyArgs -> WhileLoopOp)
            | 35 -> u_void           st |> (fun () NoTyArgs -> LetOp)
            | 36 -> u_RecdField      st |> (fun prop tyargs -> InstancePropSetOp(prop tyargs))
            | 37 -> u_tup2 u_NamedType u_string st |> (fun (a,b) tyargs -> let finfo = bindField(a,b,tyargs) in if finfo.IsStatic then StaticFieldGetOp(finfo) else InstanceFieldGetOp(finfo))
            | 38 -> u_void           st |> (fun () NoTyArgs -> LetRecCombOp)
            | 39 -> u_void           st |> (fun () NoTyArgs -> AppOp)
            | 40 -> u_void           st |> (fun () (OneTyArg(ty)) -> ValueOp(null,ty,None))
            | 41 -> u_void           st |> (fun () (OneTyArg(ty)) -> DefaultValueOp(ty))
            | 42 -> u_PropInfoData   st |> (fun (a,b,c,d) tyargs -> let pinfo = bindProp(a,b,c,d,tyargs) in if pinfoIsStatic pinfo then StaticPropSetOp(pinfo) else InstancePropSetOp(pinfo))
            | 43 -> u_tup2 u_NamedType u_string st |> (fun (a,b) tyargs -> let finfo = bindField(a,b,tyargs) in if finfo.IsStatic then StaticFieldSetOp(finfo) else InstanceFieldSetOp(finfo))
            | 44 -> u_void           st |> (fun () NoTyArgs -> AddressOfOp)
            | 45 -> u_void           st |> (fun () NoTyArgs -> AddressSetOp)
            | 46 -> u_void           st |> (fun () (OneTyArg(ty)) -> TypeTestOp(ty))
            | 47 -> u_void           st |> (fun () NoTyArgs -> TryFinallyOp)
            | 48 -> u_void           st |> (fun () NoTyArgs -> TryWithOp)
            | 49 -> u_void           st |> (fun () NoTyArgs -> VarSetOp)
            | _ -> failwithf "u_constSpec, unrecognized tag %d" tag
        Unique constSpec
    let u_ReflectedDefinition = u_tup2 u_MethodBase u_Expr
    let u_ReflectedDefinitions = u_list u_ReflectedDefinition

    let unpickleExpr (localType: Type) referencedTypes bytes = 
        unpickleObj localType.Assembly referencedTypes u_Expr bytes

    let unpickleReflectedDefns localAssembly referencedTypes bytes = 
        unpickleObj localAssembly referencedTypes u_ReflectedDefinitions bytes

    //--------------------------------------------------------------------------
    // General utilities that will eventually be folded into 
    // Microsoft.FSharp.Quotations.Typed
    //--------------------------------------------------------------------------
    
    /// Fill the holes in an Expr 
    let rec fillHolesInRawExpr (l:Expr[]) (E t as e) = 
        match t with 
        | VarTerm _ -> e
        | LambdaTerm (v,b) -> EA(LambdaTerm(v, fillHolesInRawExpr l b ),e.CustomAttributes)
        | CombTerm   (op,args) -> EA(CombTerm(op, args |> List.map (fillHolesInRawExpr l)),e.CustomAttributes)
        | HoleTerm   (ty,idx) ->  
           if idx < 0 || idx >= l.Length then failwith "hole index out of range";
           let h = l.[idx]
           match typeOf h with
           | expected when expected <> ty -> invalidArg "receivedType" (String.Format(SR.GetString(SR.QtmmRaw), expected, ty))
           | _ -> h

    let rec freeInExprAcc bvs acc (E t) = 
        match t with 
        | HoleTerm   _  -> acc
        | CombTerm (_, ag) -> ag |> List.fold (freeInExprAcc bvs) acc
        | VarTerm    v -> if Set.contains v bvs || Set.contains v acc then acc else Set.add v acc
        | LambdaTerm (v,b) -> freeInExprAcc (Set.add v bvs) acc b
    and freeInExpr e = freeInExprAcc Set.empty Set.empty e

    // utility for folding
    let foldWhile f st (ie: seq<'T>)  = 
        use e = ie.GetEnumerator()
        let mutable res = Some st
        while (res.IsSome && e.MoveNext()) do
            res <-  f (match res with Some a -> a | _ -> failwith "internal error") e.Current;
        res      
    
    [<NoEquality; NoComparison>]
    exception Clash of Var

    /// Replace type variables and expression variables with parameters using the
    /// given substitution functions/maps.  
    let rec substituteInExpr bvs tmsubst (E t as e) = 
        match t with 
        | CombTerm (c, args) -> 
            let substargs = args |> List.map (fun arg -> substituteInExpr bvs tmsubst arg) 
            EA(CombTerm(c, substargs),e.CustomAttributes)
        | VarTerm    v -> 
            match tmsubst v with 
            | None -> e 
            | Some e2 -> 
                let fvs = freeInExpr e2 
                let clashes = Set.intersect fvs bvs in
                if clashes.IsEmpty then e2
                else raise (Clash(clashes.MinimumElement)) 
        | LambdaTerm (v,b) -> 
             try EA(LambdaTerm(v,substituteInExpr (Set.add v bvs) tmsubst b),e.CustomAttributes)
             with Clash(bv) ->
                 if v = bv then
                     let v2 = new Var(v.Name,v.Type)
                     let v2exp = E(VarTerm(v2))
                     EA(LambdaTerm(v2,substituteInExpr bvs (fun v -> if v = bv then Some(v2exp) else tmsubst v) b),e.CustomAttributes)
                 else
                     reraise()
        | HoleTerm _ -> e


    let substituteRaw tmsubst e = substituteInExpr Set.empty tmsubst e 

    let readToEnd (s : Stream) = 
        let n = int s.Length 
        let res = Array.zeroCreate n 
        let i = ref 0 
        while (!i < n) do 
          i := !i + s.Read(res,!i,(n - !i)) 
        done;
        res 

    let decodedTopResources = new Dictionary<Assembly * string, int>(10,HashIdentity.Structural)

#if !FX_NO_REFLECTION_METADATA_TOKENS
#if FX_NO_REFLECTION_MODULE_HANDLES // not available on Silverlight
    [<StructuralEquality;StructuralComparison>]
    type ModuleHandle = ModuleHandle of string * string
    type System.Reflection.Module with 
        member x.ModuleHandle = ModuleHandle(x.Assembly.FullName, x.Name)
#else
    type ModuleHandle = System.ModuleHandle
#endif
#endif

   
#if FX_NO_REFLECTION_METADATA_TOKENS // not available on Compact Framework
    [<StructuralEquality; NoComparison>]
    type ReflectedDefinitionTableKey = 
        // Key is declaring type * type parameters count * name * parameter types * return type
        // Registered reflected definitions can contain generic methods or constructors in generic types,
        // however TryGetReflectedDefinition can be queried with concrete instantiations of the same methods that doesn't contain type parameters.
        // To make these two cases match we apply the following transformations:
        // 1. if declaring type is generic - key will contain generic type definition, otherwise - type itself
        // 2. if method is instantiation of generic one - pick parameters from generic method definition, otherwise - from methods itself
        // 3  if method is constructor and declaring type is generic then we'll use the following trick to treat C<'a>() and C<int>() as the same type
        // - we resolve method handle of the constructor using generic type definition - as a result for constructor from instantiated type we obtain matching constructor in generic type definition 
        | Key of System.Type * int * string * System.Type[] * System.Type
        static member GetKey(methodBase:MethodBase) = 
            let isGenericType = methodBase.DeclaringType.IsGenericType
            let declaringType = 
                if isGenericType then 
                    methodBase.DeclaringType.GetGenericTypeDefinition() 
                else methodBase.DeclaringType
            let tyArgsCount = 
                if methodBase.IsGenericMethod then 
                    methodBase.GetGenericArguments().Length 
                else 0
#if FX_RESHAPED_REFLECTION
            // this is very unfortunate consequence of limited Reflection capabilities on .NETCore
            // what we want: having MethodBase for some concrete method or constructor we would like to locate corresponding MethodInfo\ConstructorInfo from the open generic type (canonical form).
            // It is necessary to build the key for the table of reflected definitions: reflection definition is saved for open generic type but user may request it using
            // arbitrary instantiation.
            let findMethodInOpenGenericType (mb : ('T :> MethodBase)) : 'T = 
                let candidates = 
                    let bindingFlags = 
                        (if mb.IsPublic then BindingFlags.Public else BindingFlags.NonPublic) |||
                        (if mb.IsStatic then BindingFlags.Static else BindingFlags.Instance)
                    let candidates : MethodBase[] =
                        downcast (
                            if mb.IsConstructor then
                                box (declaringType.GetConstructors(bindingFlags))
                            else
                                box (declaringType.GetMethods(bindingFlags))
                        )
                    candidates |> Array.filter (fun c -> 
                        c.Name = mb.Name && 
                        (c.GetParameters().Length) = (mb.GetParameters().Length) &&
                        (c.IsGenericMethod = mb.IsGenericMethod) &&
                        (if c.IsGenericMethod then c.GetGenericArguments().Length = mb.GetGenericArguments().Length else true)
                        )
                let solution = 
                    if candidates.Length = 0 then failwith "Unexpected, failed to locate matching method"
                    elif candidates.Length = 1 then candidates.[0]
                    else
                    // here we definitely know that candidates
                    // a. has matching name
                    // b. has the same number of arguments
                    // c. has the same number of type parameters if any

                    let originalParameters = mb.GetParameters()
                    let originalTypeArguments = mb.DeclaringType.GetGenericArguments()
                    let EXACT_MATCHING_COST = 2
                    let GENERIC_TYPE_MATCHING_COST = 1

                    // loops through the parameters and computes the rate of the current candidate.
                    // having the argument:
                    // - rate is increased on EXACT_MATCHING_COST if type of argument that candidate has at position i exactly matched the type of argument for the original method.
                    // - rate is increased on GENERIC_TYPE_MATCHING_COST if candidate has generic argument at given position and its type matched the type of argument for the original method.
                    // - otherwise rate will be 0
                    let evaluateCandidate (mb : MethodBase) : int = 
                        let parameters = mb.GetParameters()
                        let rec loop i resultSoFar = 
                            if i >= parameters.Length then resultSoFar
                            else
                            let p = parameters.[i]
                            let orig = originalParameters.[i]
                            if p.ParameterType = orig.ParameterType then loop (i + 1) (resultSoFar + EXACT_MATCHING_COST) // exact matching
                            elif p.ParameterType.IsGenericParameter && p.ParameterType.DeclaringType = mb.DeclaringType then
                                let pos = p.ParameterType.GenericParameterPosition
                                if originalTypeArguments.[pos] = orig.ParameterType then loop (i + 1) (resultSoFar + GENERIC_TYPE_MATCHING_COST)
                                else 0
                            else
                                0

                        loop 0 0

                    Array.maxBy evaluateCandidate candidates                       

                solution :?> 'T
#endif
            match methodBase with
            | :? MethodInfo as mi ->
                let mi = 
                    if mi.IsGenericMethod then 
                        let mi = mi.GetGenericMethodDefinition()
                        if isGenericType then
#if FX_RESHAPED_REFLECTION
                            findMethodInOpenGenericType mi
#else
                            MethodBase.GetMethodFromHandle(mi.MethodHandle, declaringType.TypeHandle) :?> MethodInfo
#endif
                        else
                            mi
                    else mi
                let paramTypes = mi.GetParameters() |> getTypesFromParamInfos
                Key(declaringType, tyArgsCount, methodBase.Name, paramTypes, mi.ReturnType)
            | :? ConstructorInfo as ci ->
                let mi = 
                    if isGenericType then
#if FX_RESHAPED_REFLECTION
                        findMethodInOpenGenericType ci
#else
                        MethodBase.GetMethodFromHandle(ci. MethodHandle, declaringType.TypeHandle) :?> ConstructorInfo // convert ctor with concrete args to ctor with generic args
#endif
                    else
                        ci
                let paramTypes = mi.GetParameters() |> getTypesFromParamInfos
                Key(declaringType, tyArgsCount, methodBase.Name, paramTypes, declaringType)
            | _ -> failwithf "Unexpected MethodBase type, %A" (methodBase.GetType()) // per MSDN ConstructorInfo and MethodInfo are the only derived types from MethodBase
#else
    [<StructuralEquality; NoComparison>]
    type ReflectedDefinitionTableKey = 
        | Key of ModuleHandle * int
        static member GetKey(methodBase:MethodBase) = 
            Key(methodBase.Module.ModuleHandle,methodBase.MetadataToken)
#endif

    [<NoEquality; NoComparison>]
    type ReflectedDefinitionTableEntry = Entry of Bindable<Expr>

    let reflectedDefinitionTable = new Dictionary<ReflectedDefinitionTableKey,ReflectedDefinitionTableEntry>(10,HashIdentity.Structural)

    let registerReflectedDefinitions (assem, resourceName, bytes, referencedTypes) =
        let defns = unpickleReflectedDefns assem referencedTypes bytes 
        defns |> List.iter (fun (minfo,exprBuilder) -> 
            let key = ReflectedDefinitionTableKey.GetKey minfo
            lock reflectedDefinitionTable (fun () -> 
                reflectedDefinitionTable.Add(key,Entry(exprBuilder))))
        decodedTopResources.Add((assem,resourceName),0)

    let tryGetReflectedDefinition (methodBase: MethodBase, tyargs: Type []) =
        checkNonNull "methodBase" methodBase
        let data = 
          let assem = methodBase.DeclaringType.Assembly
          let key = ReflectedDefinitionTableKey.GetKey methodBase
          let ok,res = lock reflectedDefinitionTable (fun () -> reflectedDefinitionTable.TryGetValue(key))

          if ok then Some res else

            let qdataResources = 
                // dynamic assemblies don't support the GetManifestResourceNames 
                match assem with 
                | a when a.FullName = "System.Reflection.Emit.AssemblyBuilder" -> []
                | null | _ -> 
                    let resources = 
                        // This raises NotSupportedException for dynamic assemblies
                        try assem.GetManifestResourceNames()
                        with :? NotSupportedException -> [| |]
                    [ for resourceName in resources do
                          if resourceName.StartsWith(ReflectedDefinitionsResourceNameBase,StringComparison.Ordinal) &&
                             not (decodedTopResources.ContainsKey((assem,resourceName))) then 

                            let cmaAttribForResource = 
#if FX_RESHAPED_REFLECTION
                                CustomAttributeExtensions.GetCustomAttributes(assem, typeof<CompilationMappingAttribute>) |> Seq.toArray
#else
                                assem.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
#endif
                                |> (function null -> [| |] | x -> x)
                                |> Array.tryPick (fun ca -> 
                                     match ca with 
                                     | :? CompilationMappingAttribute as cma when cma.ResourceName = resourceName -> Some cma 
                                     | _ -> None) 
                            let resourceBytes = readToEnd (assem.GetManifestResourceStream(resourceName))
                            let referencedTypes = 
                                match cmaAttribForResource with 
                                | None -> [| |]
                                | Some cma -> cma.TypeDefinitions
                            yield (resourceName,unpickleReflectedDefns assem referencedTypes resourceBytes) ]
                
            // ok, add to the table
            let ok,res = 
                lock reflectedDefinitionTable (fun () -> 
                     // check another thread didn't get in first
                     if not (reflectedDefinitionTable.ContainsKey(key)) then
                         qdataResources 
                         |> List.iter (fun (resourceName,defns) ->
                             defns |> List.iter (fun (methodBase,exprBuilder) -> 
                                reflectedDefinitionTable.[ReflectedDefinitionTableKey.GetKey methodBase] <- Entry(exprBuilder));
                             decodedTopResources.Add((assem,resourceName),0))
                     // we know it's in the table now, if it's ever going to be there
                     reflectedDefinitionTable.TryGetValue(key) 
                );

            if ok then Some res else None

        match data with 
        | Some (Entry(exprBuilder)) -> 
            let expectedNumTypars = 
                getNumGenericArguments(methodBase.DeclaringType) + 
                (match methodBase with 
                 | :? MethodInfo as minfo -> if minfo.IsGenericMethod then minfo.GetGenericArguments().Length else 0
                 | _ -> 0)
            if (expectedNumTypars <> tyargs.Length) then 
                invalidArg "tyargs" (String.Format(SR.GetString(SR.QwrongNumOfTypeArgs), methodBase.Name, expectedNumTypars.ToString(), tyargs.Length.ToString()));
            Some(exprBuilder (envClosed tyargs))
        | None -> None

    let tryGetReflectedDefinitionInstantiated (methodBase:MethodBase) = 
        checkNonNull "methodBase" methodBase
        match methodBase with 
        | :? MethodInfo as minfo -> 
               let tyargs = 
                   Array.append
                       (getGenericArguments minfo.DeclaringType)
                       (if minfo.IsGenericMethod then minfo.GetGenericArguments() else [| |])
               tryGetReflectedDefinition (methodBase, tyargs)
        | :? ConstructorInfo as cinfo -> 
               let tyargs = getGenericArguments cinfo.DeclaringType
               tryGetReflectedDefinition (methodBase, tyargs)
        | _ -> 
               tryGetReflectedDefinition (methodBase, [| |])

    let deserialize (localAssembly, referencedTypeDefs, spliceTypes, spliceExprs, bytes) : Expr = 
        let expr = unpickleExpr localAssembly referencedTypeDefs bytes (envClosed spliceTypes)
        fillHolesInRawExpr spliceExprs expr
        
  
    let cast (expr: Expr) : Expr<'T> = 
        checkTypesSR  (typeof<'T>) (typeOf expr)  "expr" (SR.GetString(SR.QtmmExprHasWrongType))
        new Expr<'T>(expr.Tree,expr.CustomAttributes)

open Patterns


type Expr with 
    member x.Substitute substitution = substituteRaw substitution x
    member x.GetFreeVars ()  = (freeInExpr x :> seq<_>)
    member x.Type = typeOf x 

    static member AddressOf (target:Expr) = 
        mkAddressOf target    

    static member AddressSet (target:Expr, value:Expr) = 
        mkAddressSet (target,value)

    static member Application (functionExpr:Expr, argument:Expr) = 
        mkApplication (functionExpr,argument)

    static member Applications (functionExpr:Expr, arguments) = 
        mkApplications (functionExpr, arguments)

    static member Call (methodInfo:MethodInfo, arguments) = 
        checkNonNull "methodInfo" methodInfo
        mkStaticMethodCall (methodInfo, arguments)

    static member Call (obj:Expr,methodInfo:MethodInfo, arguments) = 
        checkNonNull "methodInfo" methodInfo
        mkInstanceMethodCall (obj,methodInfo,arguments)

    static member Coerce (source:Expr, target:Type) = 
        checkNonNull "target" target
        mkCoerce (target, source)

    static member IfThenElse (guard:Expr, thenExpr:Expr, elseExpr:Expr) = 
        mkIfThenElse (guard, thenExpr, elseExpr)

    static member ForIntegerRangeLoop (loopVariable, start:Expr, endExpr:Expr, body:Expr) = 
        mkForLoop(loopVariable, start, endExpr, body)

    static member FieldGet (fieldInfo:FieldInfo) = 
        checkNonNull "fieldInfo" fieldInfo
        mkStaticFieldGet fieldInfo

    static member FieldGet (obj:Expr, fieldInfo:FieldInfo) = 
        checkNonNull "fieldInfo" fieldInfo
        mkInstanceFieldGet (obj, fieldInfo)
    
    static member FieldSet (fieldInfo:FieldInfo, value:Expr) = 
        checkNonNull "fieldInfo" fieldInfo
        mkStaticFieldSet (fieldInfo, value)
    
    static member FieldSet (obj:Expr, fieldInfo:FieldInfo, value:Expr) = 
        checkNonNull "fieldInfo" fieldInfo
        mkInstanceFieldSet (obj, fieldInfo, value)

    static member Lambda (parameter:Var, body:Expr) = mkLambda (parameter, body)

    static member Let (letVariable:Var,letExpr:Expr,body:Expr) = mkLet (letVariable, letExpr, body)

    static member LetRecursive (bindings, body:Expr) = mkLetRec (bindings, body)

    static member NewObject (constructorInfo:ConstructorInfo, arguments) = 
        checkNonNull "constructorInfo" constructorInfo
        mkCtorCall (constructorInfo, arguments)

    static member DefaultValue (expressionType:Type) = 
        checkNonNull "expressionType" expressionType
        mkDefaultValue expressionType

    static member NewTuple elements = 
        mkNewTuple elements

    static member NewRecord (recordType:Type, elements) = 
        checkNonNull "recordType" recordType
        mkNewRecord (recordType, elements)

    static member NewArray (elementType:Type, elements) = 
        checkNonNull "elementType" elementType
        mkNewArray(elementType, elements)

    static member NewDelegate (delegateType:Type, parameters: Var list, body: Expr) = 
        checkNonNull "delegateType" delegateType
        mkNewDelegate(delegateType, mkIteratedLambdas (parameters, body))

    static member NewUnionCase (unionCase, arguments) = 
        mkNewUnionCase (unionCase, arguments)
    
    static member PropertyGet (obj:Expr, property: PropertyInfo, ?indexerArgs) = 
        checkNonNull "property" property
        mkInstancePropGet (obj, property, defaultArg indexerArgs [])

    static member PropertyGet (property: PropertyInfo, ?indexerArgs) = 
        checkNonNull "property" property
        mkStaticPropGet (property, defaultArg indexerArgs [])

    static member PropertySet (obj:Expr, property:PropertyInfo, value:Expr, ?indexerArgs) = 
        checkNonNull "property" property
        mkInstancePropSet(obj, property, defaultArg indexerArgs [], value)

    static member PropertySet (property:PropertyInfo, value:Expr, ?indexerArgs) = 
        mkStaticPropSet(property, defaultArg indexerArgs [], value)

    static member Quote (inner:Expr) = mkQuote (inner, true)

    static member QuoteRaw (inner:Expr) = mkQuote (inner, false)

    static member QuoteTyped (inner:Expr) = mkQuote (inner, true)

    static member Sequential (first:Expr, second:Expr) = 
        mkSequential (first, second)

    static member TryWith (body:Expr, filterVar:Var, filterBody:Expr, catchVar:Var, catchBody:Expr) = 
        mkTryWith (body, filterVar, filterBody, catchVar, catchBody)

    static member TryFinally (body:Expr, compensation:Expr) = 
        mkTryFinally (body, compensation)

    static member TupleGet (tuple:Expr, index:int) = 
        mkTupleGet (typeOf tuple, index, tuple)

    static member TypeTest (source: Expr, target: Type) = 
        checkNonNull "target" target
        mkTypeTest (source, target)

    static member UnionCaseTest (source:Expr, unionCase: UnionCaseInfo) = 
        mkUnionCaseTest (unionCase, source)

    static member Value (value:'T) = 
        mkValue (box value, typeof<'T>)

    static member Value(value: obj, expressionType: Type) = 
        checkNonNull "expressionType" expressionType
        mkValue(value, expressionType)

    static member ValueWithName (value:'T, name:string) = 
        checkNonNull "name" name
        mkValueWithName (box value, typeof<'T>, name)

    static member ValueWithName(value: obj, expressionType: Type, name:string) = 
        checkNonNull "expressionType" expressionType
        checkNonNull "name" name
        mkValueWithName(value, expressionType, name)

    static member WithValue (value:'T, definition: Expr<'T>) = 
        let raw = mkValueWithDefn(box value, typeof<'T>, definition)
        new Expr<'T>(raw.Tree,raw.CustomAttributes)

    static member WithValue(value: obj, expressionType: Type, definition: Expr) = 
        checkNonNull "expressionType" expressionType
        mkValueWithDefn (value, expressionType, definition)


    static member Var(variable) = 
        mkVar(variable)

    static member VarSet (variable, value:Expr) = 
        mkVarSet (variable, value)

    static member WhileLoop (guard:Expr, body:Expr) = 
        mkWhileLoop (guard, body)

    static member TryGetReflectedDefinition(methodBase:MethodBase) = 
        checkNonNull "methodBase" methodBase
        tryGetReflectedDefinitionInstantiated(methodBase)

    static member Cast(source:Expr) = cast source

    static member Deserialize(qualifyingType:Type, spliceTypes, spliceExprs, bytes: byte[]) = 
        checkNonNull "qualifyingType" qualifyingType
        checkNonNull "bytes" bytes
        deserialize (qualifyingType, [| |], Array.ofList spliceTypes, Array.ofList spliceExprs, bytes)

    static member Deserialize40(qualifyingType:Type, referencedTypes, spliceTypes, spliceExprs, bytes: byte[]) = 
        checkNonNull "spliceExprs" spliceExprs
        checkNonNull "spliceTypes" spliceTypes
        checkNonNull "referencedTypeDefs" referencedTypes
        checkNonNull "qualifyingType" qualifyingType
        checkNonNull "bytes" bytes
        deserialize (qualifyingType, referencedTypes, spliceTypes, spliceExprs, bytes)

    static member RegisterReflectedDefinitions(assembly, resource, serializedValue) = 
        Expr.RegisterReflectedDefinitions(assembly, resource, serializedValue, [| |]) 

    static member RegisterReflectedDefinitions(assembly, resource, serializedValue, referencedTypes) = 
        checkNonNull "assembly" assembly
        registerReflectedDefinitions(assembly, resource, serializedValue, referencedTypes)

    static member GlobalVar<'T>(name) : Expr<'T> = 
        checkNonNull "name" name
        Expr.Var(Var.Global(name, typeof<'T>)) |> Expr.Cast

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module DerivedPatterns =
    open Patterns

    [<CompiledName("BoolPattern")>]
    let (|Bool|_|)         input = match input with ValueObj(:? bool   as v) -> Some(v) | _ -> None
    [<CompiledName("StringPattern")>]
    let (|String|_|)       input = match input with ValueObj(:? string as v) -> Some(v) | _ -> None
    [<CompiledName("SinglePattern")>]
    let (|Single|_|)       input = match input with ValueObj(:? single as v) -> Some(v) | _ -> None
    [<CompiledName("DoublePattern")>]
    let (|Double|_|)       input = match input with ValueObj(:? double as v) -> Some(v) | _ -> None
    [<CompiledName("CharPattern")>]
    let (|Char|_|)         input = match input with ValueObj(:? char   as v) -> Some(v) | _ -> None
    [<CompiledName("SBytePattern")>]
    let (|SByte|_|)        input = match input with ValueObj(:? sbyte  as v) -> Some(v) | _ -> None
    [<CompiledName("BytePattern")>]
    let (|Byte|_|)         input = match input with ValueObj(:? byte   as v) -> Some(v) | _ -> None
    [<CompiledName("Int16Pattern")>]
    let (|Int16|_|)        input = match input with ValueObj(:? int16  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt16Pattern")>]
    let (|UInt16|_|)       input = match input with ValueObj(:? uint16 as v) -> Some(v) | _ -> None
    [<CompiledName("Int32Pattern")>]
    let (|Int32|_|)        input = match input with ValueObj(:? int32  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt32Pattern")>]
    let (|UInt32|_|)       input = match input with ValueObj(:? uint32 as v) -> Some(v) | _ -> None
    [<CompiledName("Int64Pattern")>]
    let (|Int64|_|)        input = match input with ValueObj(:? int64  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt64Pattern")>]
    let (|UInt64|_|)       input = match input with ValueObj(:? uint64 as v) -> Some(v) | _ -> None
    [<CompiledName("UnitPattern")>]
    let (|Unit|_|)         input = match input with Comb0(ValueOp(_,ty,None)) when ty = typeof<unit> -> Some() | _ -> None

    /// (fun (x,y) -> z) is represented as 'fun p -> let x = p#0 let y = p#1' etc.
    /// This reverses this encoding.
    let (|TupledLambda|_|) (lam: Expr) =
        /// Strip off the 'let' bindings for an TupledLambda
        let rec stripSuccessiveProjLets (p:Var) n expr =
            match expr with 
            | Let(v1,TupleGet(Var(pA),m),rest) 
                  when p = pA && m = n-> 
                      let restvs,b = stripSuccessiveProjLets p (n+1) rest
                      v1::restvs, b
            | _ -> ([],expr)
        match lam.Tree with 
        | LambdaTerm(v,body) ->
              match stripSuccessiveProjLets v 0 body with 
              | [],b -> Some([v], b)
              | letvs,b -> Some(letvs,b)
        | _ -> None

    let (|TupledApplication|_|) e = 
        match e with 
        | Application(f,x) -> 
            match x with 
            | Unit -> Some(f,[])
            | NewTuple(x) -> Some(f,x)
            | x -> Some(f,[x])
        | _ -> None
            
    [<CompiledName("LambdasPattern")>]
    let (|Lambdas|_|) (input: Expr) = qOneOrMoreRLinear (|TupledLambda|_|) input 
    [<CompiledName("ApplicationsPattern")>]
    let (|Applications|_|) (input: Expr) = qOneOrMoreLLinear (|TupledApplication|_|) input 
    /// Reverse the compilation of And and Or
    [<CompiledName("AndAlsoPattern")>]
    let (|AndAlso|_|) input = 
        match input with 
        | IfThenElse(x,y,Bool(false)) -> Some(x,y)
        | _ -> None
        
    [<CompiledName("OrElsePattern")>]
    let (|OrElse|_|) input = 
        match input with 
        | IfThenElse(x,Bool(true),y) -> Some(x,y)
        | _ -> None

    [<CompiledName("SpecificCallPattern")>]
    let (|SpecificCall|_|) templateParameter = 
        // Note: precomputation
        match templateParameter with
        | (Lambdas(_,Call(_,minfo1,_)) | Call(_,minfo1,_)) ->
            let isg1 = minfo1.IsGenericMethod 
            let gmd = if isg1 then minfo1.GetGenericMethodDefinition() else null

            // end-of-precomputation

            (fun tm -> 
               match tm with
               | Call(obj,minfo2,args) 
#if FX_NO_REFLECTION_METADATA_TOKENS
                  when ( // if metadata tokens are not available we'll rely only on equality of method references
#else               
                  when (minfo1.MetadataToken = minfo2.MetadataToken &&
#endif                  
                        if isg1 then 
                          minfo2.IsGenericMethod && gmd = minfo2.GetGenericMethodDefinition()
                        else
                          minfo1 = minfo2) -> 
                   Some(obj,(minfo2.GetGenericArguments() |> Array.toList),args)
               | _ -> None)
        | _ -> 
            invalidArg "templateParameter" (SR.GetString(SR.QunrecognizedMethodCall))

    let private new_decimal_info = 
       methodhandleof (fun (low, medium, high, isNegative, scale) -> LanguagePrimitives.IntrinsicFunctions.MakeDecimal low medium high isNegative scale)
       |> System.Reflection.MethodInfo.GetMethodFromHandle
       :?> MethodInfo

    [<CompiledName("DecimalPattern")>]
    let (|Decimal|_|) input = 
        match input with 
        | Call (None, mi, [Int32 low; Int32 medium; Int32 high; Bool isNegative; Byte scale])
          when mi.Name = new_decimal_info.Name
               && mi.DeclaringType.FullName = new_decimal_info.DeclaringType.FullName ->
            Some (LanguagePrimitives.IntrinsicFunctions.MakeDecimal low medium high isNegative scale)
        | _ -> None

    [<CompiledName("MethodWithReflectedDefinitionPattern")>]
    let (|MethodWithReflectedDefinition|_|) (methodBase) = 
        Expr.TryGetReflectedDefinition(methodBase)
    
    [<CompiledName("PropertyGetterWithReflectedDefinitionPattern")>]
    let (|PropertyGetterWithReflectedDefinition|_|) (propertyInfo:System.Reflection.PropertyInfo) = 
        Expr.TryGetReflectedDefinition(propertyInfo.GetGetMethod(true))

    [<CompiledName("PropertySetterWithReflectedDefinitionPattern")>]
    let (|PropertySetterWithReflectedDefinition|_|) (propertyInfo:System.Reflection.PropertyInfo) = 
        Expr.TryGetReflectedDefinition(propertyInfo.GetSetMethod(true))

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module ExprShape =
    open Patterns
    let RebuildShapeCombination(shape:obj,arguments) =  
        // preserve the attributes
        let op,attrs = unbox<ExprConstInfo * Expr list>(shape)
        let e = 
            match op,arguments with 
            | AppOp,[f;x]        -> mkApplication(f,x)
            | IfThenElseOp,[g;t;e]     -> mkIfThenElse(g,t,e)
            | LetRecOp,[e1]   -> mkLetRecRaw(e1)     
            | LetRecCombOp,_     -> mkLetRecCombRaw(arguments) 
            | LetOp,[e1;e2]      -> mkLetRawWithCheck(e1,e2)      
            | NewRecordOp(ty),_     -> mkNewRecord(ty, arguments)
            | NewUnionCaseOp(unionCase),_    -> mkNewUnionCase(unionCase, arguments)
            | UnionCaseTestOp(unionCase),[arg]  -> mkUnionCaseTest(unionCase,arg)
            | NewTupleOp(ty),_    -> mkNewTupleWithType(ty, arguments)
            | TupleGetOp(ty,i),[arg] -> mkTupleGet(ty,i,arg)
            | InstancePropGetOp(pinfo),(obj::args)    -> mkInstancePropGet(obj,pinfo,args)
            | StaticPropGetOp(pinfo),_ -> mkStaticPropGet(pinfo,arguments)
            | InstancePropSetOp(pinfo),obj::(FrontAndBack(args,v)) -> mkInstancePropSet(obj,pinfo,args,v)
            | StaticPropSetOp(pinfo),(FrontAndBack(args,v)) -> mkStaticPropSet(pinfo,args,v)
            | InstanceFieldGetOp(finfo),[obj]   -> mkInstanceFieldGet(obj,finfo)
            | StaticFieldGetOp(finfo),[]   -> mkStaticFieldGet(finfo )
            | InstanceFieldSetOp(finfo),[obj;v]   -> mkInstanceFieldSet(obj,finfo,v)
            | StaticFieldSetOp(finfo),[v]   -> mkStaticFieldSet(finfo,v)
            | NewObjectOp minfo,_   -> mkCtorCall(minfo,arguments)
            | DefaultValueOp(ty),_  -> mkDefaultValue(ty)
            | StaticMethodCallOp(minfo),_ -> mkStaticMethodCall(minfo,arguments)
            | InstanceMethodCallOp(minfo),obj::args -> mkInstanceMethodCall(obj,minfo,args)
            | CoerceOp(ty),[arg]   -> mkCoerce(ty,arg)
            | NewArrayOp(ty),_    -> mkNewArray(ty,arguments)
            | NewDelegateOp(ty),[arg]   -> mkNewDelegate(ty,arg)
            | SequentialOp,[e1;e2]     -> mkSequential(e1,e2)
            | TypeTestOp(ty),[e1]     -> mkTypeTest(e1,ty)
            | AddressOfOp,[e1]     -> mkAddressOf(e1)
            | VarSetOp,[E(VarTerm(v)); e]     -> mkVarSet(v,e)
            | AddressSetOp,[e1;e2]     -> mkAddressSet(e1,e2)
            | ForIntegerRangeLoopOp,[e1;e2;E(LambdaTerm(v,e3))]     -> mkForLoop(v,e1,e2,e3)
            | WhileLoopOp,[e1;e2]     -> mkWhileLoop(e1,e2)
            | TryFinallyOp,[e1;e2]     -> mkTryFinally(e1,e2)
            | TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)]     -> mkTryWith(e1,v1,e2,v2,e3)
            | QuoteOp flg,[e1]     -> mkQuote(e1,flg)
            | ValueOp(v,ty,None),[]  -> mkValue(v,ty)
            | ValueOp(v,ty,Some nm),[]  -> mkValueWithName(v,ty,nm)
            | WithValueOp(v,ty),[e]  -> mkValueWithDefn(v,ty,e)
            | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet))          


        EA(e.Tree,attrs)

    [<CompiledName("ShapePattern")>]
    let rec (|ShapeVar|ShapeLambda|ShapeCombination|) input = 
        let rec loop expr = 
            let (E(t)) = expr 
            match t with 
            | VarTerm v       -> ShapeVar(v)
            | LambdaTerm(v,b) -> ShapeLambda(v,b)
            | CombTerm(op,args) -> ShapeCombination(box<ExprConstInfo * Expr list> (op,expr.CustomAttributes),args)
            | HoleTerm _     -> invalidArg "expr" (SR.GetString(SR.QunexpectedHole))
        loop (input :> Expr)
